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ABSTRACT 


V 


goal  of  this  project  was  to  develop  a  model  course  in  the  Ada  language  to 


train  technical  managers  in  its  use  with  embedded  command  and  control  systems. 
The  course  was  developed  under  the  guidance  of  the  Higher  Order  Language 
Working  Group's  sub-committee  on  training  and  was  presented  to  DoD  technical 
managers  at  two  separate  sessions.  It  was  originally  intended  that  a  video¬ 
tape  version  of  the  course  would  be  developed  and  made  available  throughout 
the  DoD  as  well  as  industry.  This  effort  had  to  be  dropped  due  to  a  reduction 
of  the  available  funds.  Course  material  in  the  form  of  viewgraph  transparency 
masters,  course  outline,  \nd  course  notes  have  been  provided  to  DARPA  and  are 
currently  under  review.  \ 
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I.  INTRODUCTION 


To  cope  with  the  increasingly  costly  and  difficult  problem  of  defense  system 
software  management,  the  Department  of  Defense  established  the  High  Order 
Language  Working  Group  (HOLWG)  in  1975.  The  mission  of  the  HOLWG  was  to 
formulate  DoD  requirements  for  high  order  languages,  to  evaluate  existing 
languages  against  those  requirements  and  to  implement  the  minimal  set  of 
languages  for  DoD  use.  As  an  administrative  initiative,  DoD  Directive  5000.29 
mandated  the  use  of  HOLs  in  new  embedded  computer  systems  and  DoD  Directive 
5000.31  gave  an  interim  list  of  approved  HOLs.  The  HOLWG  developed  a  coordi¬ 
nated  set  of  requirements  for  a  common  DoD  HOL.  The  group  determined  that 
none  of  the  existing  languages  fully  satisfied  these  requirements  and  that  a 
single  language  meeting  the  requirements  was  both  feasible  and  desirable.  The 
Ada  language  was  the  result  of  an  extensive  design,  development  and  test  and 
evaluation  effort.  Steps  in  the  ongoing  phase  of  the  program  include  produc¬ 
tion  of  compilers  and  other  tools  for  software  development  and  maintenance, 
control  of  the  language,  and  validation  of  compilers.  It  is  intended  that 
government-funded  compilers  and  software  tools  as  well  as  the  compiler  vali¬ 
dation  facility  will  be  widely  and  inexpensively  available  and  well  main¬ 
tained. 

This  course,  Ada  Education  for  Technical  Managers,  was  designed  to  provide 
military  contractors  and  end-users  with  the  necessary  background  to  under¬ 
stand  the  value  and  impact  of  the  Ada  language  concepts  and  features.  An 
integrated  approach  to  Ada  instruction  is  used  in  which  both  management  and 
technical  rationale  and  data  are  provided.  The  course  includes  motivational 
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and  management  level  information  required  by  technical  managers  who  have  the 
responsibility  to  make  programming  language  decisions,  to  justify  those  deci¬ 
sions,  and  to  assure  acceptance  and  smooth  introduction  of  a  new  programming 
language.  In  addition,  sufficient  technical  specifics  of  the  language  such  as 
its  design  philosophy,  constructs  and  syntax  are  given  to  enable  the  technical 
manager  to  see  the  benefits  of  using  Ada  in  software  systems  and  using  its 
sophisticated  features  as  they  were  intended. 

This  report  sumnarizes  the  efforts  of  the  Georgia  Institute  of  Tech¬ 
nology  to  develop  the  model  course.  The  course  was  developed  by  the  joint 
efforts  of  the  Engineering  Experiment  Station  and  the  Department  of  Con¬ 
tinuing  Education.  The  overall  goal  was  to  develop  a  set  of  course  materials 
that  could  be  provided  to  DoD  or  other  interested  participants  at  the  cost  of 
reproduction  thus  proliferating  knowledge  of  the  Ada  language  throughout  the 
community.  Two  sub-goals  of  the  program  were  to  present  the  model  course  on 
two  occasions  to  DoD  personnel  and  to  develop  a  videotape  version  of  the 
course  that  would  also  be  made  available.  At  the  request  of  the  government 
one  of  the  two  course  presentations  was  relocated  from  Atlanta,  Georgia  to 
Fort  Belvoir,  Virginia.  The  resulting  contract  modification  deleted  the 
requirement  for  developing  the  videotape  version  of  the  course  as  there  were 
insufficient  funds  available  to  procure  this  item. 

Georgia  Tech  has  completed  the  effort  on  this  project  and  provided  copies 
of  all  course  materials  to  the  sponsoring  agency. 
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II.  TASK  OBJECTIVES 


The  overall  project  objective  was  to  develop  teaching  materials  to  be 
used  in  a  one  week  Ada  education  course  for  technical  managers.  This  included 
a  course  outline,  lecture  notes,  viewgraphs,  and  videotapes.  The  course  was 
tailored  for  persons  having  software  management  and  decision  making  responsi- 
bilities.  The  course  described  the  background  motivation  and  merits  of  Ada 
and  provided  sufficient  exposure  to  the  language  such  that  course  partici¬ 
pants  could  perforin  nontrivial  tasks  using  the  Ada  language.  In  carrying  out 
the  proposed  effort,  Georgia  Tech  performed  the  following  tasks. 

Task  I  -  Review  of  Current  Ada  Documents 

A  review  of  reference  manuals  and  teaching  materials  currently  available 
for  the  Ada  programming  language  was  conducted.  This  task  required  minimal 
effort  and  time,  but  served  to  acquaint  project  personnel  with  modifications 
to  "older"  documents  and  the  status  and  content  of  materials  already  under 
development . 

Task  II  -  Design  of  Ada  Course  Outline 

GIT/EES  and  ICS  personnel  designed  and  specified  the  structure  and  con¬ 
tent  of  the  proposed  model  Ada  language  course.  The  design  was  presented  to 
the  HOLWG  Advisory  Committee  on  Ada  Education  and  Training  for  comment  and 
approval  before  detailed  course  development  was  initiated.  The  design  con¬ 
sisted  of  an  annotated  course  outline  and  discussion  of  the  approach,  philos¬ 
ophy  and  rationale.  Drafts  of  the  course  outline  were  distributed  to  other 
cognizant  specialists  for  their  suggestions  and  comments. 

Task  III  -  Course  Development 


GIT/EES  and  ICS  personnel  developed  the  course  materials  required  to 
teach  Ada.  Considerable  attention  was  paid  to  continuity  and  clarity  of 


examples  and  explanation  and  demonstration  of  abstract  concepts  and  special 
language  features.  The  order  in  which  subcomponents  of  this  task  took  place 
followed  that  of  the  outline  produced  in  Task  II.  This  task  consumed  the 
majority  of  the  project  time  and  effort. 

Task  IV  -  Presentation  of  Course  to  Government  Personnel 

As  part  of  developing  and  evaluating  the  model  Ada  language  course,  EES 
presented  the  course  twice  to  government  personnel.  These  courses  were 
offered  on  the  Georgia  Tech  campus  and  at  Fort  Belvoir,  Virginia.  During  the 
five  days  of  the  courses,  instruction  and  workshops  were  conducted  eight  hours 
per  day. 

Task  V  -  Presentation  and  Reports 

Additional  oral  presentations  (IPRs)  were  given  during  the  term  of  the 
contract.  A  final  report  and  briefing  along  with  a  copy  of  all  teaching  aids 
developed  as  part  of  this  contract  are  being  provided  to  DARPA. 
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HI.  GENERAL  METHODOLOGY 


The  development  of  the  Ada  Course  was  based  upon  an  integrated  approach 
to  Ada  Instruction.  It  was  determined  that  the  form  and  content  of  the  Ada 
course  must  be  consistent  with  the  goals  for  which  Ada  was  developed  and  the 
methods  used  in  this  development.  (See  reference  5).  It  was  understood  that 
the  future  success  of  the  Ada  programming  language  in  helping  to  resolve  the 
DoD  software  problem  would  be  frustrated  if  Ada  itself  were  misused.  There¬ 
fore,  it  was  considered  critical  to  provide  background  not  only  on  the  mech¬ 
anics  of  using  Ada  features  but  also  on  the  rationale  for  including  specific 
features  in  Ada  in  the  chosen  form. 

The  course  was  designed  to  include  the  motivational  and  management  level 
information  required  by  technical  managers  who  have  the  responsibility  to 
make  programming  language  decisions,  to  justify  those  decisions,  to  assure 
acceptance  and  smooth  implementation  of  a  new  programming  language  and  to  meet 
project  objectives  within  time  and  cost  constraints.  In  addition,  sufficient 
technical  specifics  of  the  language  such  as  its  design  philosophy,  constructs 
and  syntax  would  be  given  to  enable  the  technical  manager  to  write  non-trivial 
programs  in  Ada  and  equip  him  to  direct  large  scale  software  development  in 
Ada  using  its  sophisticated  features  as  they  were  intended. 

In  this  way  it  was  felt  that  the  course  would  guide  the  participants  from 
the  more  traditional  style  of  programming  and  software  management  to  the 
modern  philosophies  that  are  encouraged  and  supported  by  Ada.  For  example, 
the  economic  and  reliability  incentives  of  top-down  and  structured  program¬ 
ming,  strong  data  typing  and  encapsulation  would  be  emphasized. 

Many  features  of  Ada  are  new  to  most  programmers  or  require  usage  that  is 
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different  from  other  languages.  Some  of  the  features  may  not  be  clear  from 
merely  reading  the  Ada  reference  manual.  Ada,  because  of  its  innovative 

approach,  demands  new  ways  of  thinking  and  provides  new  capabilities  for 

management.  Many  of  the  language  innovations  deserve  careful  presentation 

and  appropriate  emphasis.  Insufficient  explanation  and  motivation  of  certain 

features  would  likely  lead  to  their  misuse  or  disuse  by  both  programmers  and 

managers.  Some  unique  Ada  features  and  associated  issues  are  listed  below: 

o  strong  typing  -  benefits  gained  through  static  checking 

enhanced  reliability 
reduced  cost  of  debugging 
improved  readibility 

o  subtypes  -  concept  of  dynamic  constraints 

o  derived  types  -  added  security  over  subtypes 

o  enumeration  types  -  improvements  to  readability 

o  array  types  -  slices 

-  specification  of  indices  with  type  marks 
(dynamic  arrays) 

o  string  types  -  examples  of  flexible  string  usage  supported  by 

Ada 

o  record  types  -  protection  for  variants  and  their  discriminants 

provided  to  prevent  aliasing  (enhance  relia¬ 
bility) 

o  access  types  -  explanation  of  static  versus  dynamic  entities 

and  declaration  as  opposed  to  allocation 

-  lifetime  of  dynamic  objects 

-  efficiency  considerations 

using  access  types  instead  of  index  computations 
with  array  types 

changing  access-variable  values  versus  moving 
data 

-  dangers  inherent  with  access  types 

problems  which  can  occur  when  more  than  one 
access  variable  refers  to  the  same  object 
use  of  unintialized  access  variables 
o  type  conversion  -  why  no  implicity  coercion 

-  qualified  expressions 

-  distinctions  between  explicit  coercion  and 
resolution  of  ambiguities 

o  aggregates  -  concept  of  "value" 

-  positional  end  named  notation  in  component 
association 

-  distinct  usage  of  discriminant  constraints 
o  structured  statements  -  disciplined  and  effective  use 

-  choosing  the  appropriate  statement  for  a  given 
situation 

o  transfer  of  control  -  responsible  use  of  "exit,"  "goto,"  and  "return" 

statements 
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-  exceptions 

definition 
proper  use 

implications  for  verifiability 
dangers  -  e.g.  unwarranted  assumptions 
o  assert  statement  -  value  in  verifying  program  correctness 

-  use  in  validating 

o  formal  parameter  modes  -  security  of  static  checking 

-  prevention  of  subtle  program  dependencies  on  the 
particular  method  of  parameter  passing  used 

o  overloading  -  clarification 

o  visibility  rules  -  visibility  restrictions 

-  interaction  with  separate  compilation  feature 
o  separate  compilation  -  benefits 

individually  compile  and  test  different  units  of 
a  program  or  software  system 
flexibility  in  the  order  of  implementing  units 
minimization  of  cost  of  recompilation  after 
changes 

o  generics  -  providing  proven,  parameterizable  components 

for  software  construction 

o  data  abstraction  -  in  terms  of  packages  and  generics 

o  modules  -  physical  and  logical  interfaces 

-  visible  and  private  parts  of  specifications 

-  separation  of  the  logical  interface  from  the 
implementation 

-  support  of  Top-Down  design 

It  was  considered  to  be  especially  important  that  managers  know  how 
proper  use  of  packages  can  make  the  lower  levels  of  developing  software 
visible  to  them  and  allow  them  to  control  the  interaction  of  lower  program 
units  by  controlling  their  interfaces.  Also,  the  ability  provided  by  the 
package  feature  to  impose  intelligible  organization  on  both  software  systems 
and  software  development  operations  must  be  made  clear. 

One  of  Ada's  strong  points  is  its  facility  for  multitasking.  Tradi¬ 
tionally,  multitasking  has  been  implemented  with  relatively  undisciplined,  ad 
hoc  methods.  Processes  which  are  inherently  parallel  have  been  forced  into 
sequential  formats  due  to  the  constraints  and  limitations  of  the  programming 
language  u^ed.  Ada,  however,  provides  a  convenient  mechanism  to  express 
application  situations  and  problem  solutions  in  a  form  more  closely  repre¬ 
senting  their  "real  world"  construct.  For  many,  a  fundamental  introduction  to 


Che  concept  of  multitasking  may  be  necessary,  in  addition  an  appreciation  for 
the  security,  simplicity  and  flexibility  of  task  interaction  provided  by  the 
rendezvous  feature  of  Ada  should  be  provided. 

In  summary  it  vas  apparent  that  the  traditional  didactic  method  needed  to 
be  supplemented  with  new  teaching  aids  more  appropriate  to  Ada. 

Model  Course 

Ada  incorporates  enough  new  programming  language  constructs  and  design 
concepts  such  that  techniques  employed  in  teaching  traditional  programming 
languages  would  be  grossly  inadequate  for  a  satisfactory  presentation  of  the 
language.  As  the  examples  of  the  previous  section  demonstrate,  Ada  contains  a 
rich  repertoire  of  new  language  features,  many  of  which  would  be  unfamiliar 
even  to  highly  experienced  application  programmers.  Therefore,  it  was  neces¬ 
sary  that  innovative  methods  be  developed  if  the  material  is  to  be  presented 
1)  in  a  well  organized,  clear  fashion  and  2)  in  a  sufficiently  short  period 
such  that  programming  managers  can  afford  to  set  aside  the  time  to  attend  a 
course.  It  is  believed  that  the  demand  for  Ada  training  will  be  very  signif¬ 
icant  in  the  near  future  and  that  numerous  organizations,  institutions  and 
individuals  will  want  to  serve  that  need.  All  of  these  will  be  faced  with  the 
requirement  to  develop  teaching  techniques  suitable  for  the  unique  features 
of  Ada  as  well  as  to  tailor  the  instruction  to  their  specific  intended  audi¬ 
ence. 

The  quality  of  these  courses  is  important  to  the  success  of  the  Ada 
language  in  meeting  its  stated  objectives;  however,  most  vehicles  for  course 
quality  control  are  not  very  feasible.  For  example  DoD  could  control  the 
quality  of  Ada  training  and  education  by  1.)  undertaking  the  instruction 
responsibility  or  2.)  certifying  courses  developed  and  taught  by  others. 
Neither  of  these  options  would  be  particularly  attractive  to  an  organization 
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that  is  neither  staffed  nor  chartered  to  perforin  these  functions.  Another 
possible  vehicle  for  quality  assurance  is  to  provide  a  DoD  approved  model 
course  to  anyone  wishing  to  develop  a  course  in  Ada.  The  model  course  was 
intended  to  be  a  good  exemplar  for  those  wanting  to  develop  their  own  innova¬ 
tive  teaching  methods  and  a  needed  supplement  for  those  who  lack  either  the 
time  or  desire  to  undertake  such  an  endeavor.  In  either  case  an  acceptable 
foundation  on  which  to  build  specialized  courses  would  be  available.  EES 
proposed  to  develop  such  a  course  in  close  interaction  with  the  HOLWG  Advisory 
Committee  on  Ada  Education  and  Training.  The  product  of  this  development 
effort  was  to  be  a  set  of  approved  teaching  materials  and  aids  to  be  used  in  a 
five  day  training  course;  a  course  outline,  lecture  notes  and  viewgraphs, 
class  hand-outs,  sample  problems  and  15  hours  of  video  taped  lectures.  All  of 
these  materials  would  be  delivered  to  DARPA  and  thereafter  be  in  the  public 
domain. 

In  addition  to  the  model  course  a  set  of  realistic  examples  of  Ada 
programs  would  provide  a  valuable  teaching  aid.  Many  such  examples  were 
obtained  from  Ada  Test  and  Evaluation  (T&E)  participants  and  from  others 
developing  Ada  courses.  Additional  examples  were  developed  as  a  result  of 
interactions  with  the  Ada  Education  and  Training  Advisory  Committee. 
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IV.  RESULTS  AND  CONCLUSIONS 


The  initial  guidance  to  Georgia  Tech  for  the  development  of  the  course 
vas  provided  on  February  6,  1980  during  a  meeting  of  the  Ada  Education  and 
Training  Advisory  Committee  (see  Attachment  I).  The  committee  performed  a 
detailed  review  of  the  Georgia  Tech  model  course  and  agreed  that  the  course 
was  well  into  the  design  phase.  (These  early  efforts  were  financed  by  Georgia 
Tech  as  it  was  felt  that  such  an  important  endeavor  was  worthy  of  our  sup¬ 
port.)  Several  recommendations  were  made,  and  it  was  agreed  that  Georgia  Tech 
would  provide  a  new  syllabus  at  the  next  level  of  detail  with  supporting  words 
describing  the  proposed  examples  and  approach.  Although  it  was  agreed  that 
top-down  decomposition  would  be  an  excellent  way  to  introduce  concepts,  it  was 
generally  agreed  that  the  participants  first  needed  an  understanding  of  the 
basic  facilities  and  control  structures.  It  also  appeared  desirable  that  a 
set  of  machine  readable,  documented  examples  be  collected.  Finally,  it  was 
agreed  that  the  success  of  courses  would  be  enhanced  by  the  availability  of  a 
translator,  even  if  inefficient,  so  that  students  can  get  a  few  programs 
running. 

An  Ada  Model  Course  review  was  held  at  Georgia  Tech  on  April  28,  1980. 
During  this  meeting,  representatives  from  the  Ada  Education  and  Training 
Committee  were  presented  with  a  revised  course  outline  and  also  reviewed 
several  proposed  examples  intended  for  use  during  the  course.  As  a  result  of 
this  meeting  and  ensuing  discussion,  further  changes  were  made  to  the  course 
material . 

Another  training  meeting  was  held  in  Washington,  D.  C.  on  May  13,  1980. 
The  two  primary  instructors  and  course  material  developers  for  Georgia  Tech 
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attended  this  meeting.  The  material  was  generally  well  received,  and  it  was 
agreed  that  the  content  and  direction  of  the  course  was  appropriate. 

Shortly  after  this  meeting,  Georgia  Tech  was  asked  by  the  sponsor  to 
consider  moving  the  first  of  the  two  courses  for  DoD  personnel  from  the 
planned  location  at  Georgia  Tech  to  Fort  Belvoir,  Virginia.  The  atated  reason 
for  this  move  was  the  shortage  of  travel  funds  in  DoD.  The  sponsor  was 
advised  that  the  funds  remaining  in  the  project  could  not  allow  for  that  move 
and  also  cover  the  cost  of  developing  the  planned  videotape  version  of  the 
course.  The  sponsor  decided  to  defer  development  of  the  videotape  version  of 
the  course.  A  contract  modification  was  subsequently  issued  cancelling  the 
videotape  effort  and  directing  that  the  first  of  the  two  DoD  presentations  be 
moved  to  Fort  Belvoir,  Virginia. 

The  first  of  the  two  contract  courses  was  presented  at  Fort  Belvoir, 
Virginia  on  23-27  June  1980.  One  of  the  secondary  purposes  of  the  presenta¬ 
tion  was  to  provide  a  live  audience  for  field  testing  the  material.  Most  of 
this  aim  was  accomplished  during  the  weeks'  presentation.  Many  of  the  com¬ 
ments  were  constructive  and  enabled  Georgia  Tech  to  provide  for  changes  to  the 
material.  Georgia  Tech  feels  that  the  course  could  have  been  improved  if  a 
software  engineering  approach  had  been  used  in  its  development. 

Version  control  proved  to  be  a  major  problem  with  the  materials,  espe¬ 
cially  since  the  language  was  not  stable  during  the  development  phase  and 
Georgia  Tech  was  constantly  being  required  to  react  to  changes.  This  had 
considerable  impact  on  costs,  and  funds  for  the  remaining  development  ran  out 
before  final  preparation  of  the  course  material  had  been  completed. 

The  second  of  the  two  contract  courses  was  presented  at  Georgia  Tech  from 
July  7-11  1980.  The  course  was  attended  by  13  DoD  personnel  including  the 


members  of  Che  Ada  Education  and  Training  Committee.  In  general,  the  course 
went  well  and  participants  were  receptive  to  the  material  and  methodology.  A 
comment  session  was  conducted  on  July  11  and  the  consents  were,  for  the  most 
part,  quite  positive.  The  attendees  were  generally  satisfied  with  the  course 
handouts  and  the  visual  aids.  Most  students  felt,  that  as  an  overview  for 
managers,  the  course  contained  too  much  detail  and  too  much  programming. 
Although  the  attendees  were  purported  to  be  software  managers,  they  professed 
not  to  be  interested  in  the  programming  details.  (This  is  not  consistent  with 
our  view  as  to  what  software  managers  need  to  know  to  manage  a  large  software 
project  and  is  a  source  of  some  concern  if  this  is  a  prevalent  view  throughout 
DoD.) 

From  the  staff's  viewpoint,  Georgia  Tech  felt  that  the  material  was 
presented  at  the  proper  level  for  industry  technical  managers.  The  reordering 
of  the  material  resulting  from  the  comments  obtained  from  the  first  presenta¬ 
tion  at  Fort  Belvoir  appeared  to  be  quite  successful.  The  instructors  were 
more  comfortable  with  the  material  and  felt  that  the  presentation  went  more 
smoothly  as  a  result  of  the  changes.  The  committee  representative  indicated 
that  he  was  pleased  with  the  course  and  felt  it  satisfied  most  of  his  needs. 

He  also  recognized  that  it  was  a  management  course  and  felt  that  the  level  and 
thrust  of  the  presentation  was  quite  appropriate. 

On  July  23,  1980,  DARPA  was  provided  with  a  then  current  set  of  all 
training  materials.  Constant  changes  and  delays  in  reception  of  the  final 
reference  manual  had  severe  impact  on  cost  and  schedule.  Georgia  Tech 
received  the  final  copy  of  the  reference  manual  in  August  1980  and  made 
applicable  changes  to  the  course  material.  Copies  of  all  deliverables  were 
provided  to  DARPA  in  September-October  1980. 


12 


V.  RECOMMENDATIONS 


As  we  have  not  been  provided  with  the  results  of  the  review  of  the  course 


material,  we  are  unable  to  comment  on  any  inputs  received  from  the  reviewers. 


However,  based  upon  our  experience  in  the  development  and  presentation  of  the 
course  to  two  DoD  classes  and  two  additional  sessions  under  the  auspices  of 
the  Department  of  Continuing  Education,  the  following  recommendations  are 
provided: 

a.  Our  experience  in  the  development  and  presentation  of  the 
course  to  two  DoD  and  two  Continuing  Education  classes  have 
shown  that  the  course  approach  was  valid.  Therefore,  future 
courses  in  the  teaching  of  Ada  to  DoD  personnel  should  use  this 
course  as  a  model. 

b.  The  availability  of  a  translator  would  have  greatly  enhanced 
the  value  of  the  course.  For  an  executive  overview  or  manager 
course  it  would  have  been  an  invaluable  aid  to  understanding. 
For  a  programmer's  course  a  translator  would  be  a  necessity. 
Therefore,  all  future  courses  should  include  the  use  of  some 
sort  of  translator.  The  NYU  translator  and  interpreter  will 
shortly  be  available  from  the  U.  S.  Army  and  should  be  consid¬ 
ered  as  a  vehicle  to  satisfy  this  requirement. 

c.  The  interaction  with  the  Ada  Education  and  Training  Committee 
was  very  useful  and  should  be  an  element  in  the  development  of 
any  future  Ada  courses. 

d.  DoD  should  continue  to  explore  the  possibility  of  developing  a 
videotaped  version  of  the  course.  User  agencies/activities 
could  then  supplement  such  a  standard  package  with  material 
germane  to  their  own  specific  requirements. 

e.  Georgia  Tech  spent  considerable  in-house  time  and  effort  in 
the  investigation  of  the  use  of  color  graphics  for  course 
visuals.  It  is  felt  that  this  methodology  offers  significant 
promise  and  future  courses  should  consider  its  use,  providing 
the  costs  can  be  kept  to  a  reasonable  level. 

f.  A  set  of  realistic  examples  of  Ada  programs  would  provide  an 
invaluable  teaching  aid.  The  development  of  such  examples 
should  continue  to  be  encouraged  by  the  Ada  Joint  Project 
Office.  These  examples  should  be  provided  to  interested  user 
agencies  at  their  request. 
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1 .0  Abstract 

The  emerging  DoD  programming  language,  Ada, 
promises  to  aid  the  software  developer  by  offering 
capabilities  formerly  considered  outside  the  scope 
of  an  HOL.  Ada  is  PASCAL-llke  in  its  design  and 
Includes  such  modern  programming  concepts  as 
strong  data  typing,  blocking  and  hierarchical 
exception  handling.  In  addition  to  the 
capabilities  found  in  modern  HOLs,  Ada  Includes 
some  relatively  new  areas:  real  time  processing, 
libraries,  and  assertions. 

This  paper  compares  the  present  military 
standard  languages,  JOVIAL  J73,  CMS-?  and  FORTRAN, 
tc  Ada  in  seven  areas:  design  criteria,  general 
syntax,  data  typing,  control,  functions,  real-time 
processing,  and  other  advanced  techniques.  This 
comparison  shows  which  areas  are  new  to  the  HOL 
arena,  and  how  modern  programming  techniques  have 
beer.  used  to  increase  the  applicability  and 
reliability  of  traditional  HOL  areas. 


? • 0  HOL  Feature  Study 

Tne  HOL  Feature  Study  compares  several  HOLs 
at  a  functional  level  and  obtains  their  relative 
ranking.  Sections  3.0  and  9.0  give  the  basis  for 
our  selection  of  the  four  HOLs  analyzed  in  the 
feature  study;  Section  5.0  explains  the 

methodology  used  in  the  feature  study;  and 
Section  6.0  analyzes  the  results  of  these  scores. 
The  primary  conclusions  of  the  feature  study  are 
as  follows: 

•  CMS-?,  JOVIAL,  and  Ada  fully  support  the 
functional  requirements  of  meet  military 
software  systems. 

•  FORTRAN  77  supports  many  types  of 

processing  but  is  missing  low-level  1/0, 
partial  word  data  manipulation,  and 
tightly  packed  records. 

•  J7?  and  Ada  contain  significant 
improvements  over  CMS-?  and  FORTRAN  in  the 
areas  of  reliability  and  maintainability. 


•This  work  was  sponsored  by  the  Air  Force  Avionics 
Laboratory  under  contract  F336’5-78-C-l966. 


•  All  four  languages  encourage  the  use  of 
structured  programming  control  constructs. 

•  Ada  and  J73  provide  strong  typing  (i.e. 
grouping  data  of  like  value  ranges  and 
operations  under  specific  type  names) 
which  allows  significant  reliability 
improvements  in  code. 

•  Although  Ada  Is  top  rated  according  to 
features,  it  will  not  be  easy  to  learn  and 
it  presents  some  difficulties  to  compiler 
implementors. 


3.0  History  of  High.  Order  Languages 

HOLs  were  originally  developed  in  the  late 
fifties  to  present  mathematical  elgorithss  to  a 
computer.  FORTRAN,  one  of  the  earliest,  was 
designed  expressly  to  translate  numeric  formulas. 
ALGOL  was  somewhat  more  elegant  in  its  approach, 
but  again  its  primary  purpose  was  the  expression 
of  mathematical  algorithms.  The  Air  Force 
subsequently  developed  JOVIAL  by  tailoring  much  of 
ALCOL  to  the  needs  of  conmand  and  control  systems. 
Similarly,  the  Navy  developed  CMS-?  because  it 
needed  more  capability  than  the  conventional 
languages  possessed. 

These  early  languages  grew  as  the  computer 
technology  grew.  The  old  familiar  languages  were 
modified  and  extended  to  meet  new  situations, 
often  situations  not  anticipated  in  the  original 
language.  COBOL  was  defined  to  address  the 
problems  of  business  data  processing  where 
mathematics  is  limited  to  financial  areas  and 
there  is  a  stronger  need  for  manipulation  and 
display  of  character  data.  PL/1  was  defined  ir. 
the  mid  60's  In  an  attempt  to  bridge  the 
scientific  and  business  application  areas.  As 
such  it  Included  the  major  features  of  COBOL  as 
well  as  those  of  FORTRAN,  ALCOL,  and  JOVIAL. 

All  six  of  these  major  programml ng.  languages 
were  designed  primarily  as  Improvement s  In  power 
and  capatMIly  over  existing,  languages.  Benefits 
to  progi ammers  were  derived  from  the  continuous 
addition  of  new  features. 

Not  until  the  definition  or  PATCAl  in  1971 
was  a  language  formulated  whose  primary  design 
goal  was  to  aid  the  programmer  in  developing  his 
software.  It  includes  a  rich  set  of  data  types 
and  allows  only  a  small  set  of  control  structures 
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supi'Ort  mg  structured  programs.  The  advent  of 
RAGCAL  represents  the  point  in  n>mputrr  .wlrnrr 
when  sufficient  understanding,  of  HOL  problems  and 
beneficial  IIOL  technique:)  had  been  accumulated  to 
address  the  proper  engineering  of  these  languages. 
The  emphasis  shifted  from  ex press mg  the  problem 
for  the  machine  to  expressing  the  problem  for  the 
programmer.  Ada  builds  the  philosophy  of  PASCAL 
Into  a  language  powerful  enough  to  support  large 
software  systems. 


A.O  High  Order  Languages  Selected 

The  evolution  and  major  characteristics  of 
the  languages  selected  for  the  HOL  Feature  Study 
can  be  discussed  against  this  genera]  background. 
FORTRAN,  JOVIAL,  and  CMS-?,  three  widely  used 
languages  from  the  DoD  list  of  approved  high  order 
languages,  were  originally  selected  for  this 
study.  When  the  Dod  common  high  order  language 
effort  remained  on  schedule  and  a  single  language 
design  for  Ada  was  chosen  in  May,  1979,  it  was 
decided  to  also  evaluate  Ada  to  keep  the  HOL 
Feature  Study  -at  the  state  of  the  art. 

The  next  step  after  selecting  the  four 
languages  was  to  choose  the  exact  dialect  for  each 
language.  Each  language  presented  its  own  special 
problems.  Standardization  has  beer,  a  major 
problem  in  the  use  of  high  order  languages  since 
their  inception.  Throughout  their  history 
proliferation  of  dialects  and  language  derivations 
have  occurred  ir.  spite  of  on-gomg  standardization 
efforts.  Recently  these  standardization  efforts 
have  become  increasingly  stronger  within  the 
Department  of  Defense  and  are  just  now  beginning 
to  exhibit  results. 

A1  tr.cugh  a  standard  for  FORTRAN  IV  was 
estatlished  in  1966,  most  current  FORTRAN 
compilers  support  a  superset  or  FORTRAN  IV.  For 
example,  the  extensions  to  FORTRAN  supported  by 
these  compilers  incorporate  more  modern 
structuring  techniques,  reduce  the  rigidity  of  the 
fixed  formats  for  statements  and  comments,  and 
provide  character  manipulation  facilities. 
Although  there  is  not  a  consensus  in  the  selection 
or  the  implementation  of  these  extensions  among 
the  various  compilers,  it  would  be  unrealistic  to 
limit  the  evaluation  of  FORTRAN  to  the  10  year  old 
standard  FORTRAN  IV  subset.  In  1977,  the  ANSI 
standard  for  FORTRAN  was  updated  to  include 
several  of  the  more  common  extensions  such  as 
Improved  1/0,  blocked  1F-THEN-ELSE,  character 
string  manipulations  and  wider  use  of  expressions 
in  place  or  integers.  However,  few  compilers  that 
support  FORTRAN  77  are  currently  available.  In 
order  to  reflect  these  Improvements,  the  FORTRAN 
feature  study  analysis  Is  based  on  FORTRAN  77 
(Ref. 2)  and  FAR  (Ref. 3).  the  FORTRAN  compiler  for 
PDP-11'S,  which  is  representative  of  commonly 
available  extended  FORTRAN  compilers. 

The  JOVIAL  language  has  been  used  by  the  Air 
Force  since  1999.  It  is  a  derivative  of  ALGOL  and 
was  specifically  modified  to  support  command  and 
control  systems.  As  an  ALGOL  derivative  It 
contains  the  blocked  structures  necessary  '->r 


structured  programming  and  har  had  a  mort  freely 
formatted  -.(niece  input  than  KOHIRAN.  Addition* 
for  command  and  control  systems  include  In. -level 
rather  than  high-level  1/0,  logical  decision 
making  based  on  flag:*.,  and  the  capability  to  build 
large  systems  consisting  of  several  independently 
compiled  modules. 

Like  FORTRAN,  JOVIAL  also  suffered  from  the 
proliferation  of  dialects  and  minor  differences 
between  implementations.  In  1967,  a  version  of 
JOVIAL  J3  was  established  by  the  Air  Force  as  its 
standard  programming  language  for  command  and 
control  systems.  In  197?  a  committee  report  was 
accepted  to  modernize  J3.  The  new  dialect,  J73/1, 
was  adopted  as  the  official  Air  Force  standard, 
but  a  JOVIAL  implementation  called  J3B  was 
developed  based  upon  a  preliminary  report  from  the 
modernization  committee.  Due  to  schedule 
considerations,  J3B  was  used  on  several 
operational  flight  programs  (Fit  and  D-1)  and 
underwent  further  modifications  picking  up  strong 
typing  rules  and  tighter  control  of 
inter-compilation  unit  interfaces.  In  late  1976, 
the  Air  Force  undertook  an  effort  to  standardize 
on  a  single  dialect  of  JOVIAL  by  incorporating  the 
proven  capabilities  of  J3B  into  the  otherwise  more 
modern  J73/1.  The  result  of  this  effort  is  known 
as  J73  and  contains  improvements  over  both  J73/I 
and  J3B.  The  MIL-STD-1989A  definition  of  JOVIAL 
(J73)  (Ref.1))  has  become  the  official  Air  Force 
standard  and  has  been  selected  for  evaluation 
under  the  HOL  feature  study. 

The  Navy  has  taken  a  much  stronger  approach 
to  the  control  and  standardization  of  their 
language,  CMS-?.  It  is  based  upon  the  Compiler 
System-1  ICS-1)  first  used  by  the  NAVI  circa  199!*. 
When  it  was  decided  in  1 9t>t  to  upgrade  CS-1,  the 
task  or  coordinating  the  effort  was  giver,  to  what 
is  now  the  Fleet  Combat  Direction  Systers  Support 
Activity  (FCDSSA).  FCDSSA  has  complete  control 
over  the  generation  and  distribution  of  all  CMS-T 
compilers  within  the  Navy.  In  upgrading  CS-i,  it 
was  decided  to  include  the  best  features  of 
existing  languages  while  maintaining  as  much 
compatibility  as  possible  with  existing  CS-1 
programs.  As  a  result  CMS-?  includes  the  features 
of  structured  programming  and  the  ability  to 
specify  packed  tables  for  interfacing  with 
hardware  defined  data  structures,  but  it  also 
contains  more  primitive  constructs  which  are  eften 
redunoant.  (Ref.  9) 

In  addition  to  rigorously  controlling  the 
CMS-?  language,  the  Navy  has  also  standardized  on 
the  processors  to  be  used  in  its  systems.  The 
AN/UYK-7  is  a  large  mainframe  and  the  two 
mini -computer  families  used  are  the  AN/CTA-RO  and 
the  CP-tk?.  Thus  while  CMS-?Y  represents  a 
significant  update  to  CMS-?,  CMC-?M  is  merely  the 
tailoring  of  CMS-?T  to  the  AN/UYK-'O  processor. 
Although  CMS-?  is  fairly  machine  independent, 
CM5-?M  documentation  gives  the  impression  of 
machine  dependency  because  of  the  processor 
standardization  and  the  strong  hardware/software 
association.  Because  it  is  the  most  recent 
language  definition.  CKS-?M,  as  defined  in  the 
M-90R9  CMT-?Y  (?0)  User  Manual  (Ref. 6),  was  chosen 
for  the  feature  study  analysis. 
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Unlike  tin*  othrr  three  1  .inp.ungen ,  Ada  lias  3 
vry  short  history.  II  In  the  result  of  .in 
intensive  effort  to  standardize  on  a  .uncle 
language  for  embedded  computer  r.ystei up  throughout 
Dol).  The  Hich  Order  LanRuif.es  Work  inf.  Croup 
(HOLWC)  was  orf.mi zed  in  1975.  In  rpvicwinf.  the 
existing  Janfuagcs,  the  HOLWC  found  that  no 
existing  language  satisfactorily  met  their  broad 
range  of  requirements.  The  HOLWC  then  began 
successively  refining  the  language  requirements 
over  a  four  year  period.  This  process  was  highly 
interactive,  receiving  inputs  from  numerous 
contractors  as  well  as  the  individual  military 
branches.  Four  preliminary  PASCAL-like  language 
designs  were  evaluated  and  the  language  design 
narrowed  to  two  candidates,  called  FED  (Bef.7)  and 
CREEN  (Ref. 8).  The  two  design  teams  modified 
these  languages  according  to  the  final  requirement 
specifications  found  in  the  STEELMAN  (Ref. 9) 
document.  As  a  result  of  an  intensive  evaluation 
by  both  contractors  and  military  teams,  the  CREEN 
language  design  for  Ada  was  selected  in  May  of 
1979.  This  will  undergo  a  test  and  evaluation 
period  during  which  tests  was  run  on  an  Ada 
simulator.  Final  revisions  to  the  Ada  language 
definition  will  be  made  in  early  198O.  The  Ada 
language  as  defined  by  the  March  15  Reference 
Manual  for  the  CREEN  Programming  Language  will  be 
evaluated  under  the  HOL  feature  study. 


b.O  Feature  Study  l«*-iultn 

Hy  quantifying  the  scoring  a*  much  as 
possible  and  selecting  specific  scoring  criteria, 
much  of  the  HOL  feature  study  effort  was 
accomplished  hy  the  comparison  approach.  With 
most  features,  determining  the  number  of  points  a 
particular  language  should  receive  was 
straightforward.  Even  though  languages  were 
scored  by  more  than  one  reviewer,  general 
agreement  occurred  on  the  first  pass  and  minor 
differences  were  quickly  resolved.  Each  feature 
was  resolved  into  a  number  of  scoring  criteria 
which  were  evaluated  independently.  For  example, 
the  "Bit  Strings"  feature  was  broker.  into 
assignment;  equivalence  or  n'jr.-equ:  val  ence; 
complement,  intersection,  union  and  symmetric 
difference;  and  set  membership  (substrings). 
These  were  each  assigned  a  maximjm  value  of  2  or  3 
and  the  languages  were  each  scored  or.  that  range 
for  that  criterion.  These  results  were  summed  to 
give  the  final  score  for  that  feature. 

The  remainder  of  this  section  correlates  the 
resulting  feature  study  scores  with  tiic- 
conclusions  stated  earlier  in  the  ir.trod  jetor,  tc 
Lection  ?.C.  Tables  1  and  I]  provide  a  su--.:.ry  of 
the  raw  scores  and  a  grouping  of  the  individual 
feature  scores  into  more  general  categories. 


5-0  HOL  Feature  Study  Methodology 

Tne  common  HOL  language  effort  has  resulted 
in  another  major  contribution  to  the  HOL  Feature 
Study.  Tne  set  of  features  used  to  compare 
FORTRAN,  JOVIAL  J73,  CMS-2M,  and  Ada  is  based  upon 
the  STEELMAN  language  requirements.  STEELMAN 
represents  the  culm. nation  of  four  years  of 
intensive  discussion  and  interaction  of  literally 
thousands  of  high  order  language  users  and 
experts.  We  have  reviewed  these  requirements, 
selecting  fc  general  goals  and  At  specific  language 
features  required  by  embedded  computer  systems. 

Project  members  independently  weighted  the  5 2 
features  from  one  to  ten  according  to  the 
feature's  importance  with  respect  to  general 
programming  requirements.  After  discussion,  each 
feature  was  assigned  a  general  weight  by  group 
consensus.  Table  I  lists  the  5 2  features,  their 
associated  paragraphs  in  STEELMAN  and  their 
maximum  programming  weights. 

Having  thus  arrived  at  a  maximum  score  for 
each  feature,  specific  scoring  criteria  were 
developed  to  further  quantify  the  analysis  and  to 
facilitate  consistency  across  language 
evaluations.  The  scoring,  criteria  were  each 
assigned  relative  values  so  that  their  relative 
importance  was  maintained  and  their  totals  equaled 
the  maximum  allotted  to  the  feature.  Finally, 
Independent  evaluations  were  performed  on  Ada, 
J73,  CMS-?  and  FORTRAN. 


The  totals  from  Table  I  give  an  ordering  of 
the  power  of  the  four  languages  studied.  The 
Ordering  (from  weakest  to  strongest:  FORTRAN, 
CMS-? ,  J73.  Ada)  is  not  surprising.  FORTRAN  is 
the  oldest  language  and  of  the  four  is  the  only 
one  not  specifically  designed  for  military 
systems.  Ada  represents  the  most  resent  language 
design  thcc-y  and  hart  the  STEELMAN  requirements  as 
a  guideline.  Tne  higher  score  of  J7i  over  CMS-? 
reflects  the  inclusion  of  stronger  typing, 
exception  handling,  and  stricter  parameter 
matching  in  the  recent  J73  upgrade. 

Differences  between  the  lanp-ages  are 
explained  in  greater  detail  ir.  Sections  t.t  thru 
fc.9,  which  cover  each  language  individually. 

Before  discussing  the  language  differences, 
we  should  point  out  the  comnorality  among  the 
languages.  With  the  revisions  made  in  the  1977 
version  of  FORTRAN,  all  four  languages,  now  support 
structured  programming.  This  is  indicated  by  the 
relatively  high  subtotals  r or  the  CONTROL  category 
in  Table  11.  The  point  is  further  made  that 
FORTRAN  and  CMS-?  were  penalized  primarily  for  the 
lack  of  short  circuiting  (not  really  part  of 
structured  programming)  and  minor  shortcomings 
with  respect  to  WHILE  loops  and  loop  EXITS. 
(Refer  to  Features  23  to  3?,  Tabic  I.) 

In  fact.  If  the  scores  were  adjusted  to 
disregard  strong  typing,  real  time  processing, 
exception  handling,  and  separate  translation 
facilities,  the  scores  for  all  four  languages 
would  be  relatively  consistent.  This  is  not  to 
say  that  these  features  are  ret  important.  They 
represent  the  major  improvements  made  by  Ada  and 


FEATURE 

tellman 

ADA 

FOI' 

J7  3 

CMS 

MAX 

1 . Rel iabi 1 l ty 

1A.B 

10 

5 

6 

5 

10 

DESIGN 

2. Maintainability 

1C 

8 

5 

8 

6 

10 

CRITERIA 

3. Efficiency 

ID 

5 

6 

6 

6 

9 

A .Simpl i city 

IE 

6 

6 

5 

2 

7 

5. Machine  Independence 

1G 

10 

9 

7 

5 

10 

6. Complete  Definition 

1H 

10 

4 

7 

8 

10 

7. General  Syntax 

2A.B.D 

7 

6- 

6 

4 

8 

CENERAL 

8. Syntactic  Extensions 

2C 

5 

5 

3 

3 

5 

SYNTAX 

9. Identifiers 

2E,F 

6 

2 

6 

3 

7 

10. Literals 

2G,H 

e 

7 

8 

8 

6 

1 1 .Comments 

21 

9 

8 

10 

10 

10 

12. Strong  Typing 

3A.B.D 

8 

1 

4 

3 

8 

13- Type  Definitions 

3C.D 

8 

0 

5 

0 

8 

19. Numeric  Types 

31A.D-H 

9 

7 

10 

10 

10 

15. Numeric  Operations 

31B.C 

10 

10 

10 

8 

10 

DATA 

16. Enumeration  Types 

32A.B 

5 

0 

4 

0 

5 

TYPING 

17. Boolean  Type 

3C 

5 

3 

5 

4 

5 

18. Character  Types 

32  D 

8 

5 

8 

5 

8 

19. Arrays 

33A-E 

10 

7 

8 

7 

10 

20. Records 

33F-H 

8 

0 

5 

4 

6 

21. Indirect  Types 

331. J 

5 

0 

3 

2 

5 

22. Bit  Strings 

3^A.B 

5 

2 

5 

3 

5 

23. Encapsulation 

35A.B 

5 

0 

2 

0 

5 

29 .Scoping 

35C,5C,C,7C 

10 

3 

9 

6 

10 

25. Declarations 

5A,B,D,F 

10 

4 

10 

9 

10 

26. Initial  Values 

5E 

5 

5 

4 

5 

5 

27. Expressions 

4  a  -G 

10 

9 

9 

9 

10 

28. Control  Structures 

6A ,  B 

8 

6 

7 

6 

8 

CONTROL 

29«Condi tional  Control 

6A,C 

10 

6 

10 

10 

10 

30. Iterative  Control 

6A,E 

9 

4 

10 

6 

10 

31. Explicit  Transfer 

6A,C 

8 

8 

7 

5 

8 

32. Short  Circuiting 

6D 

5 

0 

5 

0 

5 

33- Procedures 

7A,D 

10 

9 

9 

7 

10 

39.Recu-sion 

7B 

5 

0 

5 

0 

5 

FUNCTIONS 

35. Parameter  Passing 

7F-H 

10 

9 

6 

10 

I/O 

36. Aliasing 

71 

5 

0 

3 

u 

5 

37. Low  Level  I/O 

8a,E 

5 

0 

u 

3 

5 

38. Hi  Level  I/O 

8p,C,D,F 

6 

9 

0 

0 

9 

39-Parallel  Processing 

9A,B,H,I,J 

k 

0 

0 

0 

5 

90. Mutual  Exclusion 

9C 

5 

0 

0 

0 

5 

REAL 

91 .Scheduling 

9D 

4 

0 

0 

0 

5 

TIME 

92. Real  Time 

9E 

5 

0 

1 

1 

5 

PROCESSING 

93 . Interrupts 

— 

5 

0 

3 

0 

5 

49.Async.  Termination 

9G 

5 

0 

0 

0 

5 

95. Exception  Handling 

10A-E.C 

9 

0 

5 

0 

10 

96 . Assertions 

5F 

3 

1 

0 

5 

97. Data  Representation 

1 1A 

8 

0 

fc 

6 

8 

OTHER 

98. Lang.  Interface 

1 1E 

10 

4 

10 

4 

10 

TECHNIQUES 

99. Optimizations 

11C,D,F 

8 

1 

5 

1 

8 

50. Libraries 

12A 

6 

? 

7 

8 

9 

51. Separate  Trans. 

1?B 

8 

7 

7 

B 

8 

52. Generic  Definitions 

12D 

5 

0 

1 

0 

5 

TOTALS 

373 

177 

290 

210 

394 

Table  1.  Functional  Comparisons 
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to  a  lesser  extent  J73.  The  point  to  be  nude  is 
th.it  the  remaining  features  would  represent 
functional  capabilities  sufficient  for  many 
problems.  All  four  languages  provide  these 
functions  with  only  minor  Improvements  made  in  J73 
and  Ada.  The  additions  made  by  these  languages 
don't  provide  new  capabilities,  but  rather,  allow 
the  programmer  to  state  the  solution  in  a  more 
precise,  reliable,  and  straightforward  manner. 
These  characteristics  are  precisely  those  that 
will  aid  maintenance  efforts  and  reduce  life  cycle 
costs . 

6.1  FORTRAN 

Although  FORTRAN  contains  the  basic 
functional  capabilities  required  by  many  problems, 
FORTRAN  programmers  would  encounter  difficulties 
in  several  areas:  low-level  1/0,  partial  word 
data,  and  tightly  packed  records. 

Features  37  and  68  are  those  most  pertinent 
to  low-level  1/0.  As  can  be  seen,  FORTRAN 
contains  no  provisions  for  explicitly  specifying 
low-level  I/O  instructions.  These  must  be 
implemented  as  calls  to  assembly  language 
routines.  Since  1/0  operations  normally  entail 
only  a  single  machine  instruction,  subroutine 
linkage  overheads  of  3  to  A  words  represent 
significant  increases.  A  much  greater  problem 
occurs  on  time  critical  I/O  operations  (e.g., 
disable  interrupts)  which  can't  allow  any 
intervening  overhead  instructions. 

FORTRAN  is  unable  to  specify  data  items 
requiring  less  than  a  full  word  or  byte  of  memory, 
as  is  indicated  by  features  47,  22  and  16.  In 
order  to  access  specific  bit  strings  within  a 
word,  the  programmer  must  use  explicit  masking  and 
shifting  operations.  In  addition  to  being  error 
prone,  this  makes  code  less  understandable  because 
descriptive  names  cannot  be  associated  with 
specific  bits. 

6.?  CMS-? 

CMS-?  corrects  most  shortcomings  found  in 
FORTRAN.  Specified  tables  may  contain  items  of 
different  types  and  may  assign  exact  sizes  and  bit 
positions  to  individual  items.  Using  these 
features,  the  CMS-?  programmer  can  access  each 
field  by  an  appropriate  variable  name.  Low-level 
I/O  in  CMS-?  is  accomplished  by  allowing  insertion 
of  assembly  language  directly  between  CMS-? 
statements.  Although  these  features  are  not 
controlled  as  well  as  the  corresponding  features 
in  Ada  and  J73,  they  allow  many  military  software 
systems  to  be  well  represented  in  CMS-?. 

The  major  shortcomings  in  CMS-?  are  its  lack 
of  strong  typing  and  the  presence  of  outdated 
features.  This  second  characteristic  was  caused 
by  the  decision  to  maintain  downward  compatibility 
of  compilers.  It  results  in  special  cases  and 
duplicated  features  throughout  CMS-?.  The 
ISO-plus  keywords  found  in  CMS-?  are  Indicative  of 
its  complexity  for  both  implementation  and 
maintenance  programmers.  Secondly,  CMS-?  is 
comparatively  weak  in  data  typing.  Scoping  is 


less  powerful;  some  data  types  are  either 
missing,  an  in  the  case  of  enumeration  types,  or 
are  restricted,  as  in  the  case  of  bit  strings; 
and  the  user  is  not  allowed  to  group  data  by 
defining  his  own  types.  These  features  are 
desirable  to  facilitate  code  reliability. 

6.3  JOVIAL  (J73) 

Table  1  shows  that  J73  consistently  outscores 
CMS-?.  The  number  and  types  of  constructs  found 
in  J73  have  been  greatly  condensed  without  losing 
any  of  the  functional  capability  found  in  CMS-?. 
Beyond  CMS-?,  J73  has  included  the  basis  for 
strong  typing,  fundamental  exception  handling, 
tighter  control  of  functions  and  procedures,  and 
slight  improvements  in  control  structures.  The 
strong  typing  and  exception  handling  capabilities 
of  J73  were  adopted  from  early  work  on  Ada  and  as 
such  are  not  nearly  as  well  developed  as  those  in 
Ada.  The  four  areas  mentioned  here  account  for 
most  of  the  60  point  difference  between  J73  and 
CMS-?.  The  overall  effect  of  these  features  is  an 
increase  in  reliability  and  maintainability  as 
indicated  in  features  1  and  ?  of  the  General 
Design  Criteria  section.  (Table  I) 

J73's  major  improvements  in  control 
structures  are  loop  EXITS  and  short  circuiting  of 
conditional  expressions.  Loop  EXITS  provide  a 
controlled  alternative  to  explicit  GO  TO's  or 
match  flags  for  exiting  iterative  loops  upon  the 
occurrence  of  desired  conditions.  Snort 
circuiting  allows  the  use  of  logical  properties  to 
optimize  complex  decisions.  For  example,  the 
decision 

IF  ArO  or  B=0  or  (CrO  and  D=  1 ) 
is  known  to  be  true  as  soon  as  A  is  round  to  equal 
zero,  and  the  remaining  conditions  need  not  be 
checked. 

J73  introduces  several  improvements  to 
functions  and  procedures.  Strong  parameter  type 
checking  is  supported  across  separate  compilation, 
as  well  as  within  compilation  units.  Machine 
specific  functions  and  procedures  allow  a  well 
controlled  means  of  introducing  low-level  I/O. 
J73  compilers  will  recognize  a  special  set  of  what 
look  like  procedure  or  function  calls  as 
requesting  inline  generation  of  mac;  ‘.ne  specific 
instructions.  Recursive  procedures  are  also 
supported.  These  improvements  to  functions  and 
procedures  allow  compile-time  error  detection  in 
this  area  and  result  in  more  reliable  code. 

Another  J73  improvement  related  to  procedures 
and  functions  is  the  abort  capability  covered  in 
feature  45.  An  alternate  return  may  be  specified 
on  procedure  calls.  Execution  of  the  ABORT 
statement  within  called  procedures  will 
subsequently  return  control  to  the  most  recently 
specified  alternate  return.  This  provides  an 
efficient  means  of  handling  error  conditions 
without  destroying  the  single-entry-slngle-exlt 
benefits  of  structured  programming. 

The  most  Important  reliability  improvements 
in  J73  are  obtained  from  its  strong  typing 
features.  This  is  reflected  by  J73's  ?6  point 


tirrr.i rw>  over  CM;i-r  in  tin-  Dat.i  T y | •  I iik  aria  of 
r.il.lr  II.  Fimmrrnt  ton  typei  are  provided  to 
i:noc  1  a l r  rnnall  lints  of  v.i I n«v  wltli  particular 
vari.iblrr..  J73  also  requires  explicit  converMon 
between  data  of  differing  types  and  forces  pointer 
variables  to  always  refer  to  ttic  same  kind  of 
tablr.  User  defined  typer,  are  allowed  to  identify 
items  with  similar  character! sties .  These 
constructs  encourage  better  system  design  due  to 
better  data  definition  and  partitioning.  The 
Increased  data  definitions  also  allow  the  compiler 
to  more  completely  identify  incorrect  variable 
usages . 

6.0  Ada 

Ada  takes  the  benefits  found  in  J73's  strong 
typing  one  step  further.  Strong  data  typing  is 
the  fundamental  characteristic  of  Ada.  In 
addition  to  user  definable  types,  Ada  provides 
sub-types  to  specify  absolute  value  ranges  which 
are  automatically  checked  across  all  assignments. 
Moreover,  most  features  in  Ada  contain  nuances 
which  reflect  the  assumption  of  very  strong  data 
typing.  Overloading  of  procedures,  encapsulation, 
and  generic  program  units  are  examples  of  new 
concepts  in  Ada  highly  associated  with  strong 
typing.  The  impact  of  strong  typing  in  Ada  is  so 
dominant  as  to  force  a  new  style  of  programming. 
This  new  approach  greatly  enhances  the  production 
of  reliable  code.  These  capabilities  are 
Indicated  by  Ada's  high  scores  in  the  Design 
Criteria  and  Data  Typing  areas  of  Table  I. 

While  providing  this  radical  departure  from 
the  other  three  languages,  Ada  consistently  builds 
upon  their  proven  capabilities.  Comparing  the  Ada 
scores  in  Table  1  with  those  of  the  second  place 
language,  J73,  we  find  35  features  in  which  Ada 
receives  a  higher  score  and  only  5  in  which  it 
scores  lower.  In  these  five  features  the  Ada 
score  is  lower  by  only  a  single  point  in  each 
case. 

The  second  area  of  significant  improvement  in 
Ada  is  the  Inclusion  of  real  time  processing 
constructs.  In  this  section  of  Table  II,  Ada 
receives  almost  a  full  score  while  the  other 
languages  receive  almost  no  points  at  all.  The 
Ada  language  contains  the  fundamentals  of  a  real 
time  executive.  Presently  such  executives  are 
implemented  via  several  routines  particular  to 
each  operating  system.  In  Ada,  desired  executive 
control  and  synchronization  of  independant  tasks 
can  be  obtained  by  proper  selection  of  built-in 
language  constructs.  Incorporation  of  these 
features  directly  in  the  language  not  only  reduces 
Implementation  efforts  but  also  establishes  a 
consistent  approach  across  systems. 

Ada's  score  of  373  out  of  a  possible  39k 
points  clearly  marks  it  as  the  most  desirable 
language  choice.  There  are  a  few  reservations, 
however,  concerning  Ada  due  to  its  early  stage  of 
development.  Ada  has  Just  been  defined  as  of 
March,  1979,  and  is  still  undergoing  refinement. 
No  Ada  compiler  has  yet  been  implemented.  As  we 
have  discussed  above,  Ada  imposes  a  new  style  of 
HOL  programming.  It  Includes  many  new  features 


unldmlli.ii  to  a  large  s.-mment  of  progr ammera. 
While  providing  many  benefits,  these  feature*  will 
require  a  learning  process.  They  also  present,  new 
impicment.it  ion  problems  to  compiler  designers. 
Certainly,  additional  complexity  should  be  avoided 
in  any  changes  made  during  the  Ada  test  and 
evaluation  process  and  the  importance  of  Initial 
compiler  implementation  efforts  should  not  be 
underestimated. 


ADA 

FOR 

J73 

CMS 

MAX 

Design  Criteria 

19 

35 

in 

3? 

56 

General  Syntax 

35 

?8 

33 

28 

38 

Data  Typing 

ill 

67 

9? 

66 

112 

Control 

50 

33 

ne 

36 

51 

Functions  A  I/O 

*3 

19 

30 

20 

kk 

Real  Tine  Froccssipg  28 

0 

4 

1 

30 

Other  Techniques 

57 

15 

k2 

27 

63 

Totals 

373 

177 

290 

210 

39k 

Table  II.  Summary  of  Results 
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An  Introduction  to  Ada 


Course  Outline 


FIRST  DAY 

Overview  of  Ada 

History  of  Ada,  comparison  to  present  military  standard 
languages,  introduction  to  Ada  Features 

Example  I  -  Introductory  Example 

Program  structure,  lexical  units,  declarations,  basic 
statements 

Example  II  -  Procedures  and  Functions 

Declaration  and  parameter  modes,  blocks,  visibility,  type 
declarations,  statements,  type  equivalence,  operators  and 
operands 

SECOND  DAY 

Example  III  -  Record  Handling 

Records  and  record  aggregates,  packages,  case  statement, 
input-output,  program  structure,  visibility,  separate 
compilation 

Example  IV  -  Enumeration  Types 

Enumeration  Types,  Array  aggregates,  named  parameter 
association 

Case  Study  I  -  Program  Design  Using  Packages 

THIRD  DAY 

Example  V  -  Overloading  and  Exceptions 

Overloading,  exceptions,  exceptions  in  packages 

Example  VI  -  List  Processing 

Access  types,  data  abstraction,  generics,  discriminants, 
variant  records 

Case  Study  II  -  Real  Time  Control  -  Overview 

FOURTH  DAY 

Example  VII  -  Fundamentals  of  Tasking 
Task  concepts 

Example  VIII  -  Task  Interactions 

Entries,  accept  statements,  rendezvous,  task  attributes, 
select  statements 

Case  Study  II  -  Real  Time  Control  -  Implementation 

Summary 


ADA  INTRODUCTION 


SYNTAX 

-  designed  for  readability 
DECLARATIONS  and  TYPES 

-  factorization  of  properties,  maintainability 

-  abstraction,  hiding  of  implementation  details 

-  reliability,  due  to  checking 

-  floating  point  and  fixed  point,  portability 

-  access  types,  utility  and  security 


STATEMENTS 

-  assignment,  iteration,  selection,  transfer 

-  uniformity  of  syntax  (comb  structure) 

-  generally  as  simple  as  possible 

(e.g.,  iteration  control) 

SUBPROGRAMS 

-  procedures  and  functions 

-  logically  described  parameter  modes 

(as  opposed  to  definition  by 
implementation  description) 

-  overloading 


PACKAGES 

-  modularity  and  abstraction 

-  structuring  for  complex  programs 

-  hiding  of  implementation,  maintainability 

-  major  uses : 

.  named  collections  of  declarations 
.  groups  of  related  subprograms 
.  encapsulated  data  types 


t 


LIBRARIES 


-  separate  compilation 

-  generics 

-  program  development  environment 


TASKING 

-  can  be  done  completely  with  Ada  features 

-  single  concept  for  intertask  communication 

and  synchronization 

-  interface  with  external  devices 

-  designed  for  efficient  implementation 


EXCEPTION  HANDLING 

-  for  reliability  of  real-time  systems 

-  standard  vs.  user-defined  exceptions 

-  meant  mainly  for  handling  errors 

(rather  than  as  a  general  programming 
technique) 


MACHINE  DEPENDENCIES 

-  representation  specifications 

-  interface  with  other  languages 

-  low  level  I/O 


! 


Ada  IS  DESIGNED  FOR 
WRITING  LARGE  PROGRAMS 


I 

I 

L 


Ada  HAS  FEATURES  TO  ALLOW 
SUITABLE  EXTENSIONS  FOR 
A  PARTICULAR  APPLICATION 


Ada  IS  A  DESIGN  LANGUAGE 


OBJECTIVES 


Program  Structure 
Lexical  Units 
Declarations 
Basic  Statements 


LOGICAL  STRUCTURE 


with  TEXT  10} 


procedure  MIN_MAX_SUM  is 


I 


declarative 

part 


beg  in 


sequence  of 
statements 


T 

I 

I 

I 


end  MIN  MAX  SUM; 


*  . 
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TEXTUAL  STRUCTURE 


with  TEXT_IO; 
procedure  MIN_MAX_SUM  is 

•  •  • 

beg  in 

•  •  • 

for  ...  loop 


if  ...  then 

•  •  • 

elsif  .  .  .  then 


end  if; 


end  loop; 

•  •  • 

end  MIN  MAX  SUM; 
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A  COMPLETE  PROGRAM 


with  TEXT_IO; 
procedure  MIN_MAX_SUM  is 

—  This  program  reads  a  list  of  one  or  more  integers  and 

—  reports  the  minimum,  maximum,  and  sum  of  them.  The 

—  program  expects  this  list  to  be  preceded  by  an  integer 

—  value  giving  the  number  of  integers  in  the  list. 

use  TEXT_IO; 

ITEM  :  INTEGER; 

MAXIMUM  :  INTEGER; 

MINIMUM  :  INTEGER; 

SUM  :  INTEGER; 

NUMBER_OF_ITEMS  :  INTEGER  range  1 .. INTEGER' LAST; 
begin 

GET(NUMBER_OF_ITEMS) ;  —  Read  the  length  of  the  list 

—  Assume  NUMBER_OF_ITEMS  >=  1 

GET (ITEM) ; 

MAXIMUM  :=  ITEM; 

MINIMUM  :=  ITEM; 

SUM  :=  ITEM; 

for  N  in  2. . NUMBER_OF_ITEMS  loop  —  Loop  variable  is 

—  declared  automatically 
—  Its  scope  is  range  of 

—  loop  statement 

GET (ITEM) ; 

if  ITEM  >  MAXIMUM  then 
MAXIMUM  :=  ITEM; 
elsif  ITEM  <  MINIMUM  then 
MINIMUM  :=  ITEM; 
end  if; 

SUM  :=  SUM  +  ITEM; 
end  loop; 

PUT ( "  MAXIMUM  IS  • ) ;  PUT( MAXIMUM) ;  NEW_LINE; 

PUT ( "  MINIMUM  IS  ");  PUT(MINIMUM) ;  NEW_LINE ; 

PUT ( "  SUM  IS  ");  PUT(SUM) ;  NEWSLINE; 

end  MIN  MAX  SUM; 
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LEXICAL  UNITS 


IDENTIFIERS 
RESERVED  WORDS 
NUMBERS 
STRINGS 
DELIMITERS 

any  number  of  spaces  between  lexical  units 
at  least  one  space  between  adjacent  identifie 


or  numbers 


IDENTIFIERS 


MIN_MAX_SUM 

MINMAXSUM 

ITEM 


—  underscore  is  significant 

—  not  the  same  as  MIN  MAX  SUM 


NUMBER_OF_ITEMS  —  no  distinction  made 

Number_Of_Items  —  between  upper  and 

—  lower  case 

Size  30  —  identifier  may  include  digits 

—  Composed  of  letters,  digits,  and 

isolated  underscores 

—  First  character  must  be  a  letter 

—  Last  character  must  be  a  letter 

or  a  digit 

—  All  characters  are  significant; 

length  of  identifier  restricted 
only  by  length  of  line 
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RESERVED  WORDS 


proced  ure 
beg  in 
end 

if  then 
for  in 
(not  a 


is 

else 
loop 
complete 


elsi  f 

list) 


Relatively  small  set  of  reserved  words  which  must  be 
memor i zed . 

Predefined  identifiers  (attributes)  may  be  used  as  regular 
identifiers . 
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PREDEFINED  TYPES 


INTEGER 

FLOAT  —  — -■* 

”  BOOLEAN 

CHARACTER 

Part  of  pre-defined  environment 
Not  reserved  words 

PREDEFINED  ATTRIBUTES 

—  declaration  from  example 

NUMBER_OF_I TEMS  : INTEGER  range  1 .. INTEGER ' LAST 
INTEGER  is  a  predefined  type 

LAST  is  a  predefined  attribute  which  returns  the  maximum 
value  of  any  scalar  type 

T'FIRST  returns  the  minimum  value  of  the  type  T 
T'LAST  returns  the  maximum  value  of  the  type  T 


NUMBERS 


Integer  literals 

2500 
2  500 
2E  00 
25^2 

211001  1100_0100# 
2tl00_Tll_000__100# 

814704# 

16#9C4I 

Different  representations  of  same  value 

Based  integers  can  be  represented  with 
any  base  from  2  to  16 


Real  literals 

12.75 
1275. 0E-2 
0.1275e2 

2#1100.11# 

2#110011.0#e-2 
2#0. 110011IE4 

8114.6# 

8#146. 0#el 

Different  representations  of  same  value 
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STRINGS 


"MAXIMUM 

V" 

"HE  SAID 

"THIS  IS 
"A  STRING 

NUNN 

m  * 


IS"  —  a  string  is  an  array  of  characters 

—  a  string  of  length  one 

•"NO""."  —  included  string  bracket  roust  be 

—  written  twice 


"&  —  concatenation  used  to  represent 

—  strings  which  are  longer  than 

—  one  line 


—  a  one-character  string  representing 

—  the  double  quote 

—  represents  an  empty  string 
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DELIMITERS 


Special  characters 


+  -  /  * 

#  :  ;  •  ' 

<  *  > 

(  ) 

i  &  #  % 


Compound  symbols 


** 

>=  <*  /= 

<<  » 


=> 


<> 


replacement 

range  definition 

exponentiation  operation 

relational  operators 

identifies  labels  which 
are  objects  of  GOTO's 

indicates  relationship 
between  a  name  and 
a  value,  action,  or 
declaration 

stands  for  unspecified  range 
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COMMENTS 


—  This  program  reads  a  list  of  integers 


—  A  comment  starts  with  a  double  hyphen 

—  and  is  terminated  by  the  end  of  the  line 


begin  —  Body  of  sort 


the  first  two  hyphens 
start  the  comment 


OBJECT  DECLARATIONS 


ITEM  :  INTEGER; 

identif ier_list  :  type_mark; 

identif ier_list  :  type_mark  constraint; 
NUMBER_OF_I TEMS  :  INTEGER  range  1. . INTEGER' LAST; 


Initialization  - 

identif ier_list  :  type__mark  :«  expression; 

COL_NUM,  ROW  Jim  :  INTEGER  0; 

READY,  BUSY,  RUN  ;  BOOLEAN  :*  FALSE; 
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RANGE  CONSTRAINT 


NUMBER_OF_ITEMS  :  INTEGER 

range  1. . INTEGER' LAST; 


Form : 

simple_expression  . .  simple__expression 

L  ..  R  describes  values  from  L  to  R  inclusive 
L  >  R  indicates  empty  range 

type  of  range  constraint  is  type  of  expression 
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STATEMENTS 


ASSIGNMENT 

IF 

LOOP 


SUBPROGRAM  CALL 


ASSIGNMENT  STATEMENT 

variable  :=  expression; 

A  A 

I  I 

I  I 

I _ same  type _ | 

MAXIMUM  :=  ITEM; 

SUM  :=  SUM  +  ITEM; 

compile  time  checking 

No  automatic  conversion 
across  replacement  operator 


IF  STATEMENT 


i f  condition  then 

sequence  of_statements 

end  if  ; 


Ex  ample 

if  MONTH  *  12  and  DAY  »  31  then 
MONTH  :=  1; 

DAY  :*  1; 

YEAR  :=  YEAR  +  1; 

end  if; 
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I 

i  if  condition  then 


sequence  of  statements 


V 


1 

f 

I 


1 - 

I  elsif  condition  then 


I  sequence  of  statements 


zero 

more 


or 

times 


1 - 

I  else 

I 

I  sequence  of_statements 


optional 


end  if? 


T  ' 

i 

I  ^ 

i: 

i: 

e 

i 

i 
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*  DAYS_IN_MONTH  then 
DAY  :  =  1; 

if  MONTH  =12  then 
MONTH  :=  1; 

YEAR  :=  YEAR  +  1; 

else 


MONTH 


MONTH  +  1 


DISCRIMINANT  :  =  B  *  B  -  4.0  *  A  *  C; 
if  DISCRIMINANT  <  0.0  then 

PUT  ("  NO  REAL  ROOTS  ■); 
elsif  ABS (  DISCRIMINANT  )  <  1.0e-8  then 
PUT  (  "  EQUAL  REAL  ROOTS  "); 
ROOTS  :=  -B/2.0  *  A; 

PUT  (ROOTS) ; 

else 

PUT  ("  DISTINCT  REAL  ROOTS  "); 

•  •  • 

end  if; 
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LOOP  STATEMENT 


loop_parameter  discrete_range 


V  V 

for  N  U1  2.. NUMBER  loop 

sequence_of_statements 

end  loop ; 

1.  The  loop  parameter  is  implicitly  declared  as  a  local 
identifier;  it  (logically)  exists  only  during  the  execu¬ 
tion  of  the  loop  statement. 

2.  The  loop  parameter  acts  as  a  constant;  it  cannot  be 
altered  by  the  sequence_o f_statements . 

3.  The  loop  parameter  has  no  value  outside  the  loop. 

4.  The  discrete_range  is  evaluated  only  once,  before  the 
execution  of  the  loop  statement. 

5.  On  successive  iterations,  the  loop  parameter  is  succes¬ 
sively  assigned  values  in  increasing  order  from  the 


speci f ied 

range 

when  i_n  is 

used . 

If  reserved  word 

reverse  is 

used  , 

values  are 

assigned 

in  decreasing 

order . 
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OTHER  LOOP  EXAMPLES 


for  N  _i_n  reverse  1..80  loop 
sequence_of_statments 
end  loop; 


while  condition  loop 

sequence_o  f_statments 
end  loop; 
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LOOP  STATEMENT 


Composed  of 

iteration_specif i cat ion  (optional) 
basic_loop 

iteration_speci f ication 

while  condition 

for  loop_parameter  i_n  discrete_range 

for  loop_parameter  jUi  reverse  discrete_range 

basic  loop  - 
loop 

sequence_of_statements 
end  loop; 
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LABELED  LOOPS 


SEARCH: 

loop 


end 


SEARCH ; 


SUMMATION: 

for  I  1..N  loop 


end  loop  SUMMATION; 


Compiler  will  check  labels  for  proper  nesting. 
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EXAMPLE  II 

PROCEDURES  AMD  FUNCTIONS 


II. 100 


OBJECTIVES 


Procecedures  and  functions 
declaration 
parameter  mode 

Blocks 

Visibility 

Type  declarations 

Statements 

Type  equivalence 


type  FLOAT_ARRAY  is  array  (INTEGER  range  <>)  of  FLOAT 


function  AVERAGE  (V  :  in  FLOAT  ARRAY)  return  FLOAT  is 


SUM  s  FLOAT  :*  0.0; 
beg  in 

for  I  in  V' FIRST. .V' LAST  loop 
SUM  ;«  SUM  +  V(I)  ; 
end  loop; 

return  SUM  /  FLOAT (V' LENGTH) ; 


end  AVERAGE; 


with  MATH_LIB; 

procedure  STATISTICS  (V  :  in  FLOAT_ARRA¥  ; 

AVG,  STD_DEV  :  out  FLOAT  )  is 

SUM  s  FLOAT  :=  0.0; 

beg  in 

AVG  :=  AVERAGE (V); 

for  I  in  V' FIRST. .V' LAST  loop 

SUM  :=  SUM  +  (AVG  -  V(I))**2; 
end  loop; 

STD_DEV  :*  MATH_LIB . SQRT ( SUM  /  FLOAT (V ' LENGTH)  ); 
end  STATISTICS; 
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TYPES  and  DECLARATIONS 


A  type  characterizes  a  set  of  values  and  a  set  of  operations 
applicable  to  those  values. 


Type  declaration 

specification  of  some  attributes 
association  of  a  name  with  the  attributes 

Data  object  declaration 

associates  type  (attributes)  with  a  name 
creates  an  object  of  that  type 
associates  the  object  with  the  name 

Subprogram  declaration 

associates  a  block  of  code  with  a  name 
specifies  parameters 

names,  modes,  types  and  order 
specify  return  type  (functions) 


11.140 


ARRAY  TYPE  DEFINITION 


type 


name  of 
user-defined 

type 

I 

I 

I 

V 


type 

of 

index 

I 

I 

I 

V 


|  FLOAT  ARRAY  | 


1 

is  array  (I  INTEGER  range  <> 


I) 


i - T 

of  I  FLOAT  | 

I  _  I 


* 

I 


type  of 
each 

com ponent 


II. 150 


SUBPROGRAMS 


Procedures  and  Functi 


I  subprogram  specification  1 


1 - 

I  declarative  part 


beg  in 


I  sequence  of  statements 

I  “  “ 


FUNCTIONS 


Subprogram  specification  - 

function  AVERAGE  {  V  s  in  FLOAT__ARRAY  )  return  FLOAT 

function  AVERAGE  —  nature  and  name 

—  of  subprogram 

(V  :  in  FLOAT_ARRAY)  —  parameter  list 

(optional) 

return  FLOAT  —  type  of  object  to 

—  be  returned 


PARAMETER  MODES 


(V  s  in  FLOAT  ARRAY) 


for  "in"  parameters  - 


the  parameter  acts  as 
a  local  constant  whose 
value  is  provided  by 
the  corresponding  actual 
parameter 


(V  :  FLOAT  ARRAY)  is  equivalent  to  (V  :  in  FLOAT  ARRAY) 
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ARRAY  ATTRIBUTES 


function  AVERAGE  (V  :  FLOAT  ARRAY)  return  FLOAT  is 


SUM  :  FLOAT  :=  0.0; 
begin 

for  I  in  V'FIRST. .V'LAST  loop 
SUM  : *  SUM  +  V ( I ) ; 
end  loop; 

return  SUM  /  FLOAT (V* LENGTH) ; 
end  AVERAGE; 


FIRST,  LAST,  and  LENGTH  are  predefined  attributes 

For  the  array  object  V, 

V'FIRST  lower  bound  of  index  of  V 

V'LAST  upper  bound  of  index  of  V 

number  of  components  of  V 


V' LENGTH 


PROCEDURES 


Subprogram  specification  - 

procedure  STATISTICS 

(V  :  in  FLOAT_ARRAY; 

AVG,  STD  DEV  :  out  FLOAT) ; 


for  "out"  parameters  - 

the  parameter  acts  as 
a  local  variable  whose 
value  is  assigned  to  the 
corresponding  actual 
parameter  at  the  time 
of  normal  exit 


with  TEXT_IO,  MATH_LIB; 
procedure  ANALYSIS  is 


use  TEXT_IO; 

type  FLOAT_ARRAY  is  array  (INTEGER  range  <>) 
of  FLOAT; 

SIZE  :  NATURAL; 

function  AVERAGE  (...)  is 
•  •  • 

end  AVERAGE; 

procedure  STATISTICS  (...)  is 

•  e  • 

end  STATISTICS; 

begin 

GET(SIZE); 

declare 

RATE  :  FL0AT_ARRAY(1. .SIZE) ; 

average_rate7 

STD_DEV"RATE  :  FLOAT; 

beg  in 

for  I  in  1.. RATE' LAST  loop 
GET  (RATE ( I) ) ; 
end  loop; 

STATISTICS  (RATE,  AVERAGE_RATE,  STD_DEV_RATE) ; 

.  —  use  of  AVERAGE_RATE  and  STD_DEV_RATE 

.  —  in  this  code 

end ; 

Variables  in  block  no  longer  visible 
end  ANALYSIS; 


] 
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BLOCK 


declare 

i - T 

I  declarative  part  I 


beg  in 

i - r 

|  sequence  of  statements  I 

I _ I 

end; 


Execution  of  block  results  in 

elaboration  of  its  declarative  part 


followed  by 

execution  of  the  sequence  of  statements 


TEXTUAL  STRUCTURE 


function  F  is 


begin 


end  F; 


procedure  P  is 


beg  in 


end  P; 


declare 


begin 


end ; 
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SUBTYPES 


i: 


SIZE  :  NATURAL; 


NATURAL  is  a  predefined  identifier 


subtype  NATURAL  is  INTEGER 

range  1 .. INTEGER' LAST; 

where  LAST  is  a  predefined  attribute 


If  T  represents  a  scalar  type, 

T ' LAST  returns  the  maximum  value  in  the  range  of  T. 
T'FIRST  returns  the  minimum  value  in  the  range  of  T. 

i 

i 


I 

I 


procedure  SORT  (V  :  in  out  FLOAT_ARRAY  )  is 

LAST  s  INTEGER  :«  V'LAST  -  1; 

CHANGED  :  BOOLEAN ; 


procedure  SWAP  (  INDEX  :  in  INTEGER  )  is 

TEMP  s  FLOAT  :=  V(INDEX); 

begin  —  SWAP 

V ( INDEX)  :«  V ( INDEX  +  1); 

V( INDEX  +  1)  :*  TEMP; 
end  SWAP; 


begin  —  SORT 
loop 

CHANGED  :  =  FALSE; 
for  I  in  V'FIRST. . LAST  loop 
if  V(I+l)  <  V(I)  then 
SWAP (  I  ) ; 

CHANGED  :»  TRUE; 
end  if; 
end  loop; 

exit  when  LAST  <-  V'FIRST  or  not  CHANGED  ; 
LAST  s«  LAST  -  1; 
end  loop; 
end  SORT; 
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procedure  SORT  (V  :  in  out  FLOAT  ARRAY) 


for  "in  out"  parameters  - 

parameter  acts  as  a 
local  variable  and 
permits  access  and 
assignment  to  the 
corresponding  actual 
parameter . 
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NESTED  PROCEDURES 


procedure  SORT  ...  is 


declarative 

part 


begin  —  body  of  SORT 


I  sequence_o ^statements  I  executable 

I _ ~  _ I  part 


end  SORT  ; 
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NESTED  PROCEDURES 


procedure  SORT  ...  is 


LAST  :  INTEGER  :«  V'LAST  -  1; 
CHANGED  :  BOOLEAN; 


declarative 

part 


begin  —  body  of  SORT 


1 r 

I  sequence_of_statements  I  executable 

I _ I _ I  part 


end  SORT  ; 
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NESTED  PROCEDURES 


procedure  SORT  ...  is 


declarative 

part 


begin  —  body  of  SORT 


I  executable 
I  part 


end  SORT  ; 


sequence_of  statements 


LAST  s  INTEGER  :=  V'LAST  -  1; 
CHANGED  :  BOOLEAN; 
procedure  SWAP  ...  is 

end  SWAP; 
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procedure  SORT  (V  :  in  out  FLOAT_ARRAY)  is 
LAST  s  INTEGER  :*  V'LAST  -  1; 

CHANGED  :  BOOLEAN; 

procedure  SWAP  (  INDEX  :  in  INTEGER  )  is 
TEMP  s  FLOAT  :=  V(INDEX); 


beg  in 


V ( INDEX)  ;*  V ( INDEX  +  1)  ; 
V( INDEX  +1)  :*  TEMP; 

end  SWAP; 


begin  —  body  of  SORT 


end  SORT; 
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VISIBILITY 


procedure  OUTER  is 

A  :  BOOLEAN; 

B  :  BOOLEAN; 

procedure  INNER  is 

B  :  BOOLEAN;  —  Redeclaration  hides 

—  outer  B 

C  :  BOOLEAN; 


beg  in 


—  Outer  A,  inner  B  and  C 

—  are  directly  visible 

—  Outer  B  can  be  made  visible 

—  by  a  selected  component, 

—  that  is,  OUTER. B 


end  INNER; 
beg  in 


—  Outer  A  and  B  are  directly  visible 

—  Inner  B  and  C  are  not  visible 


end  OUTER; 
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NESTING  OF  STATEMENTS 


beg  in  —  body  of  SORT 

loop 


assignment ; 

for  ...  loop 


if  ...  then 

assignment ; 
assignment ; 
end  if; 

end  loop; 

exit  when  ...  ; 

assignment ; 

end  loop; 

end  SORT; 


LOOP  &  EXIT  STATEMENTS 


loop 

•  •  • 

exit  when  condition; 

•  •  • 

end  loop; 

exit  statement  causes  explicit 
termination  of  enclosing  loops 


unless 


11.330 


REPLACE 


loop 

•  •  • 

SEARCH: 

loop 

•  •  • 

exit  REPLACE  when  C_ONE 
•  •  • 

exit  when  C_TWO; 

•  •  • 

end  loop  SEARCH; 


end  loop  REPLACE; 


TYPE  EQUIVALENCE 


type  ELEMENT  is  range  0..K; 


A 

:  array 

(1. 

.N) 

of 

0.  .K; 

B 

:  array 

(1. 

•  N) 

of 

0.  .K; 

C 

:  array 

(1. 

•N) 

of 

ELEMENT 

D 

:  array 

(1. 

•  N) 

of 

ELEMENT 

A,  B,  C,  and  D  are  each  considered  to  be  of  different  and 
distinct  types  even  though  the  types  are  textually 
identical.  Thus,  the  assignment  statements 

A  :=  B; 

B  :=  C; 

are  not  allowed. 

The  assignment 

C(I)  :=  D(I); 

is  acceptable  since  the  variable  and  the  expression  are  of 
the  same  type  (ELEMENT) ,  whereas 

C(I)  :=  B(I) 

is  not  allowed. 
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r 


i 

^  A,B  :  array  (1..N)  of  0..K; 


A  and  B  are  objects  of  the  same  type 


type  VECTOR  is  array  (1..N)  of  0..K; 
C  :  VECTOR; 

D  :  VECTOR; 


C  and  D  are  objects  of  the  same  type 


Whereas  A  :=  B  and  C  :*  D  are 
valid,  A  :=  C  is  not  valid. 


i 

i 

! 

i 

I 

i 

4 

i 

I 

4 
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I' 

li 


Different  from  constraints 

If  J  :  INTEGER  range  1..10; 

K  :  INTEGER  range  1..20; 

I ,  J  and  K  are  all  of  the  same 
type  (i.e.,  INTEGER) 

I  :*  J;  —  identical  ranges 

K  :=  J;  —  compatible  ranges 

j  :«  K;  —  can  only  be  checked 

—  during  execution 

K  : =  15; 

J  :  =  K;  —  raise  the 

—  RANGE  ERROR  exception 


TYPES 


Scalar  types 


values  have  no  components;  includes 
enumeration,  integer,  and  real  types 

integer  and  real  called  numeric  types 


Composite  types 


values  consist  of  several  component 
types;  includes  arrays  and  records 


Access  types 


value  provides  access  to  other  objects 


Scalar 


Real 


Discrete 


FLOAT  fixed  point  INTEGER  Enumeration 

( incl udes 
CHARACTER 
and 

BOOLEAN) 
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LOGICAL  OPERATORS 


Operator 


Operand  type 


and  or  xor  not  BOOLEAN 

one  dimensional 
array  of  BOOLEAN 
components 


Example : 

type  BlT_VECTOR  is  array  (  1..32  )  of 
A,  B  :  BIT_VECTOR ; 

Valid  expressions: 

A  and  B 

A( 1 . .8)  or  B( 1 . .8) 

A ( 2. . 5)  xor  B(29. • 32) 


Result  type 
BOOLEAN 

same  array  type 


BOOLEAN  ; 


RELATIONAL  OPERATORS 


Operator  Operand  Type 

*  =  any  type 


<<=>>=  one  dimensional  array 

with  components  of  a 
discrete  type 


Example : 

S,  T  s  array  (1..N)  of  INTEGER; 


EQUAL  s=  TRUE; 
for  I  in  1..N  loop 

if  S(I)  =  T(I)  then 
EQUAL  :*  FALSE; 
exit; 
end  if; 
end  loop; 


can  be  written  as 
EQUAL  :*  S  *  T; 


Result  Type 
BOOLEAN 

BOOLEAN 

BOOLEAN 


Can  be  extended  to  multidimensional  arrays 


ARITHMETIC  OPERATORS 


Operator  Operand  Type  Result  Type 

+  -  integer  same  integer  type 

real  same  real  type 

*  integer  same  integer  type 

,  floating  same  floating  point  type 

mod  rem  integer  same  integer  type 


Operator 

** 


Left  Operand  Right  Operand  Result 

Type  Type  Type 

integer  positive  integer  integer 

floating  integer  floating 


TYPE  CONVERSIONS 

Explicit  type  conversions  allowed  between  closely  related  types. 
Numeric  type  conversions: 

REAL{  integer  expression  )  —  value  is  converted 

—  to  floating  point 

INTEGER  (  1.6  )  *  2  —  conversion  of  real  to  integer 

INTEGER  (-0.4  )  *  0  —  involves  rounding 


PRECEDENCE 


(lowest) 

logical 

and 

or  xor 

relational 

s 

*  <= 

<  >  >= 

adding 

+  - 

& 

unary 

+  - 

not 

multipl  ying 

* 

mod 

rem 

(Highest) 

exponentiating 

** 

All  operands 

are  evaluated 

(in  an 

undefined 

order) 

before  evaluation  of  the  corresponding  operator. 
Therefore,  the  expression 
A  and  B  or  C 

requires  parentheses;  that  is 
(A  and  B)  or  C 
or 

A  and  (B  or  C) 

The  expressions 

A  and  B  and  C 

and 

A  or  B  or  C 
do  not  require  parentheses. 


Short  circuit  control  forms  ( and  then  and  or  else)  have  same 
precedence  as  logical  operators. 

Membership  tests  ( i_n  and  not  in)  have  same  precedence  as 
relational  operators. 
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FLOATING  POINT  TYPE 


User  defined  floating  point  type: 

type  identifier  ijs  floating_point_constraint; 

where  floating__point_constraint  is 
digits  P  or 

digits  P  range  L  . .  R 
where  D  is  the  required  number  of  digits. 

Floating_point_constraint  specifies  a  minumum  requirement. 


EXAMPLES: 

type  COEFFICIENTS  ij  digits  10  range  -1.0  ..  1.0; 

type  REAL  ^s  digits  8 ; 


package  STANDARD  is 


type  INTEGER  ijs  range  implementation_def ined ; 
type  SHORT  INTEGER  range  implementation  defined; 
type  LONG_lNTEGER  ^s  range  implementation_3ef ined ; 

•  •  • 

type  FLOAT  i_s  digits  implementation_def ined 
range  implementation_def ined; 
type  SHORT  FLOAT  j_s  digits  implementation_def ined 
range~im piemen tat  ion  defined  ; 
type  L6NG  FLOAT  ij  digits~implementation  defined 
range  implementation_def ined ; 


FIXED  POINT  TYPES 


EXAMPLE: 

type  F  is  delta  0.01  range  -100.0  ..  100.0; 

where  "delta"  of  fixed  point  type  specifies  the  absolute 
value  of  the  error  bound. 


If  representation  uses  power  of  two,  14  bits  are  required 
for  the  magnitude,  i .e . , 

64  32  16  8  4  2  1  1/2  1/4  1/8  1/16  1/32  1/64  1/128 

A 

binary  point 

The  error  is  1/128  =  0.000  000  1  (base  2)  »  0.0078125  <  0.01 


SUMMARY 


l 

c 

I. 

r 


Procedures  and  functions 
declarations 
parameter  mode 

Blocks 

Visibility 

Type  declarations 

Statements 

Type  equivalence 

Operators  and  operands 


I 

l 

[ 

L 

li 
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EXAMPLE  III 

RECORD  HANDLING 


S 

* 


OBJECTIVES 


Packages 

Records  and  record  aggregates 
Case  statement 
Input  -  Output 
Program  Structure 
Visibility 
Separate  Compilation 


Example  III 


procedure  PROCESS_RECORDS  is 

package  RECORD  HANDLER  is 
— speci fTcations 
end  RECORD_HANDLER; 

use  RECORD_HANDLER; 

ITEM  :  ITEM_RECORD;  —  defined  in  RECORD_HANDLER 
NO_MORE_RECORDS  :  BOOLEAN  :=  FALSE; 

package  body  RECORD_HANDLER  is 
—  implementation 
end  RECORD_HANDLER ; 

beg  in 

OPEN_FILES; 

loop 

GET_VALID__RECORD  (ITEM,  NO_MORE  RECORDS); 
exit  when  NO  MORE_RECORDS ; 

WRITE_RECORD  (ITEM); 
end  loop; 

CLOSE_FILES; 
end  PROCESS  RECORDS; 


—  This  specification  appears  inside  of  PROCESS_RECORDS, 

—  indicated  above. 

package  RECORD_HANDLER  is 
type  ITEM_RECORD  is 
record 

ITEM  CODE  :  record 

PREFIX  ;  STRING (1. .2) ; 

NUMBER  :  range  0..9_999; 

SUFFIX  :  CHARACTER; 
end  record; 

DESCRIPTION  :  STRING ( 1 .. 30) ; 

SOURCE  ;  range  0..999_999; 
end  record; 
procedure  OPEN_FILES; 
procedure  CLOSE  FILES; 

procedure  GET_vSLID_RECORD  (REC  :  out  ITEM_RECQRD; 

END_OF_DATA  :  out  BOOLEAN) 
procedure  WRITE_RECORD  (REC  ;  in  ITEM_RECORD) ; 
end  RECORD  HANDLER; 


as  is 
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—  This  implementation  of  RECORD__HANDLER  is  similarly  meant  to 

—  appear  within  PROCESS_RECORD.”~ 

with  (TEXT  10); 

package  bocTy  RECORD  HANDLER  is 
use  TEXT  10; 

subtype  RECORD_STRING  is  STRING  (1..43); 

package  REC0RD_I0  is  new  INPUT_OUTPUT  ( ITEM_RECORD) ; 

IMMEDIATE,  DEFERRED  :  REC0RD_I0_. 0UT_F ILE 

procedure  OPEN_FILES  is 
use  REC0RD_I0; 
beg  in 

CREATE  (IMMEDIATE,  "external  file  name"); 

CREATE  (DEFERRED,  "external  file  name"); 
end  0PEN_F ILES ; 

procedure  CLOSE_FILES  is 
use  REC0RD_I0; 
beg  in 

CLOSE  (IMMEDIATE); 

CLOSE  (DEFERRED) ; 
end  C LOS E_F ILES ; 

procedure  GET_NEXT_RECORD  (REC  :  out  RECORD_STRING; 

VALID_LENGTH, 

END_OF_DATA  :  out  BOOLEAN)  is 

I  s  NATURAL; 
beg  in 

if  CHARACTER_IO.END_OF_FILE  then 
END_OF_DATA  :=  TRUE? 

else 

END_OF_DATA  :=  FALSE; 

I  :=  0; 

while  not  END_OF_LINE  and  I  <  43  loop 
I  :=  I  +  1; 

GET  (REC(I) ) ; 
end  loop; 

VALID_LENGTH  :=  I  =  43  and  END_OF_LINE; 

if  not  END_OF_LINE  then 
SKIP_LINE; 

—  advances  input  to  beginning 

—  of  next  line 
end  if; 

end  if; 

end  GET  NEXT  RECORD; 
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function  VA L I D_R E CORD  (REC  :  in  RECORD_STRING) 
return  BOOLEAN  is 

function  LETTERS  (S  :  STRING)  return  BOOLEAN  is 
begin 

for  C  in  S'FIRST. . S' LAST  loop 

if  S(C)  not  in  'A'..'Z'  and  S(C)  not  in  '  a' . z' 
then  return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  LETTERS; 

function  NUMERALS  (S  :  STRING)  return  BOOLEAN  is 
beg  in 

for  C  in  S'FIRST. .S' LAST  loop 
if  S(C)  not  in  'O’.. '9'  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  NUMERALS; 

begin  —  body  of  VALID_RECORD 

If  LETTERS  (REC( 1 . . 2) )  and  then  NUMERALS  (REC(3..6)) 

and  then  (REC(7)  =  *N'  or  REC(7)  =  'L'  or  REC(7)  =  'X') 
and  then  NUMERALS  (REC( 38 . . 43) )  then 
return  TRUE 
else 

return  FALSE 
end  if; 

end  VALID_RECORD; 

procedure  WRITE_RECORD  (REC  :  in  ITEM_RECORD)  is 
use  RECORD_IO;  ~ 
beg  in 

case  REC. ITEM  CODE. SUFFIX  of 

when  'N'  =>  WRITE  (IMMEDIATE,  REC); 

when  'X'  |  'L'  =>  WRITE  (DEFERRED,  REC); 
others  =>  null; 
end  case; 
end  WRITE_RECORD; 

procedure  WRITE__ERROR  (REC  ;  in  RECORD_STRING)  is 
beg  in 

PUT("INVALID  DATA:  *  &  REC)  ; 

NEW_LINE; 
end  WRITE  ERROR; 


1 


4 
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function  CONVERT  (R  :  RECORD_STRING)  return  ITEM_RECORD  is 

function  STRING  TO  INT  (S  :  STRING)  return  INTEGER  is 
VALUE  :  INTEGER  :=  0; 
beg  in 

for  I  in  S ' FIRST. . S 1  LAST  loop 

VALUE  :=  10  *  VALUE  +  CHARACTER  * POS (S (I) )  - 

CHARACTER' POS  ('O'); 

end  loop; 
return  VALUE; 
end  STRING_TO_INT; 

begin  —  body  of  CONVERT 

return  {ITEM  CODE  »>  (R(1..2), 

STRING  T0_INT  (R ( 3 . . 6) ) , 

R(7)>  r 

DESCRIPTION  =>  R{8..37)  , 

SOURCE  =>  STRING  TO  INT  (R (38 . . 43) ) ) ; 
end  CONVERT;  ~  “ 

procedure  GET_VALID_RECORD  (REC  :  out  ITEM_RECORD) ; 

END_OF  DATA  :  out  BOOLEAN)  is 

S  j  RECORD_STRING; 

LENGTH_ERROR  :  BOOLEAN; 
begin 
loop 

GET_NEXT_RECORD  (S  ,  LENGTH  ERROR,  END  OF  DATA); 
if  END_OF_DATA  then  "  ~  “ 

return ; 

el  si f  LENGTH_ERROR  or  else  not  VALID  RECORD(S)  then 
WRITE_ERROR (S) ; 
else 

REC  :=  CONVERT (S); 
return  ; 
end  if; 
end  loop; 

end  GET_VALID  RECORD; 


end  RECORD  HANDLER; 


INPUT  VALIDATION 
and 

PILE  SELECTION 


|  FILE  OF  | 
|  RECORDS  | 
|  (INPUT)  | 

I  I 

- n - 

I  I 
\/ 


|  RECORD | 
|  HANDLER  | 


T 


\ 


T 


/ 

/ 

/ 


\ 

\ 

\ 


/ 


file: 
OUTPUT 
Inval  id 
records 


/ 


/ 


file: 

IMMEDIATE 


\ 

\ 

\ 


INPUT: 

OUTPUT: 

IMMEDIATE: 

DEFERRED: 


string  (array  of  characters) 
string 

file  of  records 
file  of  records 


file: 

DEFERRED 


III. 160 


INPUT  RECORD  FORMAT 


[ 

i: 

j  (valid  records) 

j  POSITION  NAME 

1-7  ITEMCODE 

-  PREFIX 

-  NUMBER 

i 

!  -  SUFFIX 

>  8-37  DESCRIPTION 

38-43  SOURCE 


) 


CONTENT 

2  ALPHABETIC 
CHARACTERS 

4  NUMERALS 

N,  L,  or  X 

30  CHARACTERS 

6  NUMERALS 
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Input : 

subtype  RECORD_STRING  j_s  STRING  (1..43); 
REC  :  RECORD  STRING; 


Valid  Input 

Output  files  IMMEDIATE 

and  DEFERRED 

REC  (1..7) 

ITEMCODE 

REC  (1..2) 

PREFIX 

REC  (3. .6) 

CONVERT 

NUMBER 

REC  (7) 

- > 

SUFFIX 

REC  (8. .37) 

DESCRIPTION 

REC  (38. .43) 

SOURCE 
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ARRAY  OBJECT 


a  set  of  components  in  which  each 
component  is  of  the  same  type 

array  component  is  designated 
by  one  or  more  index  values 


RECORD  OBJECT  - 

a  set  of  components  in  which 
the  components  may  be  of 
different  types 

a  record  object  has  named  components 
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RECORD  STRUCTURE 


1 

1 

ITEM_ 

CODE 

1 

I  DESCRIPTION 

1 

~T 

1 

1 

1 

1 

1 

1 

1 

i 

1 

1 

PREFIX  | 
1 

NUMBER 

SUFFIX  t 

1 

1 

1 

A 

1 

1 

1 

1 

i 

_] 

type  ITEM_RECORD  is 
record 

ITEM_CODE  :  record 

PREFIX  :  STRING (1. .2) ; 
NUMBER  s  range  0..9_999; 
SUFFIX  :  CHARACTER; 
end  record; 

DESCRIPTION  :  STRING  (1..30); 

SOURCE  :  range  0..999_999; 

end  record; 


SOURCE 
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Object  declaration  : 

REC  :  ITEM^RECORD; 

Reference  to  the  components: 

REC. SOURCE  :=  475124; 

REC. ITEM_CODE. PREFIX  :=  "PS"; 
case  REC. ITEM_CODE. SUFFIX  is 


PROGRAM  DESIGN 


initialize 

loop 

get  valid  record 
exit  when  no  more  records 
write  to  selected  £ile 
end  loop 
clean  up 
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PROGRAM  STRUCTURE 


- OPEN  FILES 

GET 

-VALID - 

RECORD 

- WRITE  RECORD 

_ CLOSE  FILES 


— GET  NEXT  RECORD 


— VALID  RECORD - 1 

—WRITE  ERROR 
— CONVERT - STRING 


—LETTERS 
■ — NUMERALS 

TO  INT 
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PACKAGE  SPECIFICATION 

package  RECORD_HANDLER  is 
type  ITEM_RECORD  is 
record 

ITEM_C ODE  :  record 

PREFIX  :  STRING (1. .2) ; 

NUMBER  :  range  0..9_999; 

SUFFIX  :  CHARACTER; 
end  record; 

DESCRIPTION  s  STRING ( 1 .. 30)  ; 

SOURCE  :  range  0..999_999; 
end  record; 
procedure  OPEN_FILES; 
procedure  CLOSE_FILES; 

procedure  G E T_VA L I D_R  ECOR D  (REC  ;  out  ITEM_RECORD; 

END_OF_DATA  s  out  BOOLEAN); 
procedure  WRITE_RECORD  (REC  :  in  ITEM_RECORD) ; 
end  RECORD  HANDLER; 
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I 

T 


PROCESS__RECORDS 

procedure  PROCESS_RECORDS  is 

package  RECORD_HANDLER  is 
— specifications 
end  RECORD_HANDLER; 

use  RECORD_HANDLER; 

ITEM  :  ITEM_RECORDj  —  defined  in  RECORD_HANDLER 
NO_MORE_RECORDS  :  BOOLEAN  :=  FALSE ; 

package  body  RECORD_HANDLER  is 
—  implementation 
end  RECORD  HANDLER; 


begin 

OPEN_F ILES ; 
loop 

GET_VALID_RECORD  (ITEM,  NO_MORE_RECORDS) ; 
exit  when  NO__MORE_RECORDS ; 

WRITE__RECORD  (ITEM); 
end  loop; 

CLOSE  FILES; 


end  PROCESS  RECORDS 


Outline  of  RECORD  HANDLER 


with  TEXT__IO; 

package  body  RECORD_HANDLER  is 
use  TEXT_IO; 

subtype  RECORD_STRING  is  STRING  (1..43); 
package  RECORD  10  is  new  INPUT  OUTPUT 

(ITENrRECORD)  ; 

IMMEDIATE,  DEFERRED  :  RECORD  10. OUT  FILE; 


procedure  OPEN  FILES  is 


end  OPEN_F ILES ; 

procedure  CLOSE_FILES  is 
•  •  • 

end  CLOSE  FILES; 


procedure  GET_NEXT_RECORD  (REC  :  out  RECORD_STRING; 

VALID_LENGTH, 

END  OF  DATA  :  out  BOOLEAN)  is 


end  GET  NEXT  RECORD; 


tunction  VALID_RECORD  (REC  :  in  RECORD_STRING) 
return  BOOLEAN  is 

function  LETTERS  (S  :  STRING)  return  BOOLEAN  is 
•  •  • 

end  LETTERS; 

function  NUMERALS  (S  :  STRING)  return  BOOLEAN  is 
•  •  • 

end  NUMERALS; 


end  VALID  RECORD; 
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procedure  WRITE_RECORD  (REC  :  in  ITEM_RECORD)  is 
•  •  • 

end  WRITE_RECORD; 

procedure  WRITE_ERROR  (REC  :  in  RECORD_STRING)  is 
«  • 

end  WRITE_ERROR; 

function  CONVERT  (R  :  RECORD_STRING)  return  ITEM_RECORD  is 
*  •  • 

function  STRING_TO_INT  (S  : STRING)  return  INTEGER  is 
«  •  • 

end  STRING_TO_INT; 

•  •  • 

end  CONVERT; 

procedure  GET  VALID  RECORD  (REC  :  out  ITEM_RECORD; 

END_OF_DATA  :  out  BOOLEAN)  is 

•  •  • 

end  GET_VALID_RECORD; 
end  RECORD  HANDLER; 
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GET  VALID  RECORD 


procedure  GET  VALID_RECORD  (REC  :  out  ITEM  RECORD; 

END_OF  DATA  :  out  BOOLEAN)  is 

S  :  RECORD_STRING; 

LENGTH_ERROR  :  BOOLEAN; 

begin 

loop 

GET_NEXT_RECORD  (S  ,  LENGTH_ERROR,  END_OF_DATA) ; 
if  END_OF_DATA  then 

return” 

elsif  LENGTH  ERROR  or  else  not  VALID_RECORD(S)  then 
WRITE^ERR^RCS) ; 
else 

REC  :*  CONVERT(S)  ; 
return ; 
end  if; 

end  loop; 

end  GET  VALID  RECORD; 
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SHORT  CIRCUIT  CONDITION 


or  else 

expression-1  or  expression-2 

expression-2  will  be  evaluated  even 
if  expression-1  is  true 

expression-1  or  else  expression-2 

if  expression-1  is  true,  expression-2 
is  not  evaluated 


A  or  else  B  or  else  C 

evaluation  of  expressions  (A,B,C) 
proceeds  in  textual  order 

evaluation  stops  as  soon  as  an 
expression  evaluates  to  true 


GET_NEXT_RECORD 

procedure  GET__NEXT_RECORD  (REC  :  out  RECORD_S TR I NG; 

VALID_LENGTH, 

END_OF_DATA  :  out  BOOLEAN)  is 

I  :  NATURAL; 
beg  in 

if  CHARACTER_IO.END_OF_FILE  then 
END_OF_DATA  :■  TRUE 
else 

END_OF_DATA  :*  FALSE; 

I  :*  0; 

while  not  END_OF_LINE  and  I  <  43  loop 
I  :=  I  +  1; 

GET  (REC ( I ) ) ; 
end  loop; 

VALID_LENGTH  ;=  I  *  43  and  END__OF_LINE ; 
if  not  END_OF_LINE  then 
SKIP_LINE; 

—  advances  input  to  beginning 

—  of  next  line 
end  if; 

end  if; 

end  GET  NEXT  RECORD; 


III. 300 


VALID_RECORD 

(Structure) 

function  VALID_RECORD  ...  is 

function  LETTERS  ...  is 
beg  in 
•  •  • 

end  LETTERS; 

function  NUMERALS  ...  is 
begin 
•  •  • 

end  NUMERALS; 

begin  —  body  o £  VALID_RECORD 

•  •  • 

end  VALID  RECORD 


VALID  RECORD 


function  VALID_RECORD  (REC  s  in  RECORD_STRING) 
return  BOOLEAN  is 

function  LETTERS  (S  :  STRING)  return  BOOLEAN  is 
begin 

for  C  in  S' FIRST. .S' LAST  loop 

if  S(C)  not  in  'A'.^Z'  and  S(C)  not  in  'a'.-'z' 
then  return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  LETTERS; 


\ 
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MEMBERSHIP  OPERATOR 


if  S(C) 

not 

in  ' A ' . . ' Z ' 

and 

S(C) 

not 

in  ' a' . . ' 2* 

then 

return  FALSE; 

'in'  and  'not  in'  are  membership 
operators 

test  £or  membership  of  a  value 
of  any  type  within  a  corresponding 
range,  subtype,  or  constraint 

returns  boolean  value 

same  precedence  as  relational 
operators 
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function  NUMERALS  (S  :  STRING) 


return  BOOLEAN  is 
beg  in 

for  C  in  S ' F IRST. . S ' LAST  loop 
if  S(C)  not  in  *0'  . .  '9'  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 


end  NUMERALS; 


SHORT  CIRCUIT  CONDITION 

begin  —  body  of  VALID  RECORD 

if  LETTERS  (REC{1..2))  and  then  NUMERALS  (REC(3..6)) 

and  then  (REC(7)  ■  'N*  or  REC(7)  -  'L'  or  REC(7) 
and  then  NUMERALS  (REC(38. .43) )  then 
return  TRUE; 
else 

return  PALSE; 
end  i f ; 

end  VALID_RECORD; 

if  Cl  and  then  C2  and  then  C3  then 

•  •  • 

is  equivalent  to 

if  Cl  then 

i f  C2  then 
if  C3  then 
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CONVERT 


All  Character 
(STRING) 


R (1 .  .2)  - > 

R(3..6)  — >STRING_TO__INT — > 

R  ( 7 )  - > 

R(8. .37)  - > 

R ( 38 .  .43)  — >STRING  TO  INT— > 


Name 

Type 

PREFIX 

CHARACTER 

NUMBER 

1..9_999 

SUFFIX 

CHARACTER 

DESCRIPTION 

CHARACTER 

SOURCE 

1..999  999 
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PREDEFINED  ATTRIBUTE 

POS 

T'POS(X)  gives  the  ordinal  position 

of  the  value  X  in  the 
discrete  type  T 


T ' POS (T' FIRST)  =  0 


type  CHARACTER  is 


(nul , 

soh , 

stx 

’O'  , 

•1'. 

'  2' 

'A'  , 

’B*  , 

•C' 

'a'  , 

'b*  , 

•c' 

e  tx  f  •  •  •  f 

i  q  i 

•  •  •  9  7  9  / 

i  7  l 

•  ••  9  l*  f  •••  9 

i  'z*f  » •  •  ) 


Standard  ASCII  character  set 


r 


CHARACTER' POS (NUL)  =  0 

CHARACTER' POS (CHARACTER' LAST)  =127 


CHARACTER' POS ( ' 3')  ^  3 


CHARACTER ’POS( '3' ) 


CHARACTER ' POS (’O’)  =  3 


CONVERT  "475"  TO  475 


function  DEC  (  C  :  CHARACTER  ) 
return  INTEGER  is 

BASE  :  constant  INTEGER  :=  CHARACTER ' POS (' 0 ') ; 


begin 

return  CHARACTER' POS (C)  -  BASE; 
end  DEC; 


DEC( '4')  =  4 
DEC ( ' 7 ' )  *  7 


S  :=  "475" 

N  ;=  0 ; 

for  I  in  S'FIRST. .S' LAST  loop 
N  :=  N  *  10  +  DEC (S ( I ) ) ; 
end  loop; 
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function  STRING_TO_INT  (  S  :  STRING  ) 

return  INTEGER  is 

VALUE  :  INTEGER  0; 

beg  in 

for  I  in  S’FIRST  ..  S'LAST  loop 

VALUE  :=  VALUE  *  10 

+  CHARACTER' POS(S (I)) 

-  CHARACTER ' POS ( ' 0 ' ) ; 

end  loop; 

return  VALUE; 

end  STRING  TO  INT; 


ARRAY  SLICE 


function  STRING_TO_INT  (  S  :  STRING  ) 
return  INTEGER  is  ... 


STRING_TO_INT  (  "451"  )  =  451 

STRING  INTEGER 

—  declaration 

PHONE_NUMBER  s  STRING  (1..10); 

—  assignment 

PHONE  NUMBER  :=  "4048943181"; 


—  declaration 

AREA  CODE  ,  EXTENSION  :  INTEGER; 


—  assignment 
AREA_CODE  := 

STRING_TO_INT(  PHONE_NUMBER  (1..3)  ); 

—  sets  AREA_CODE  to  404 

EXTENSION  := 

STRING_TO_INT{  PHONE_NUMBER  (7.. 10)  ) 

—  sets  EXTENSION  to  3181 


—  declarations 
PHONE_NUMBER  :  STRING  (1..10); 
AREA_CODE  :  STRING  (1..3); 
EXTENSION  ;  STRING  (1..4); 


—  assignments 

PHONE_NUMBER  :=  *4048943181"; 

AREA_CODE  :*  PHONE_N UMBER  (1..3); 
EXTENSION  :*  PHONE__NUMBER  (7.. 10) 

PHONEJ4UMBER  (7.. 10)  *1815"; 

PHONE_NUMBER  (4.. 6)  J* 

PHONE_N UMBER  (1..3); 

PHONE  NUMBER  (1. .5)  := 


PHONE  NUMBER  (3.. 7); 


function  CONVERT  (  R  :  RECORD_STRING  ) 
return  ITEM_RECORD  is 

function  STRING_TO_INT  ... 

•  •  • 

end  STRING  TO  INT; 


beg  in 


return  (  ITEM_CODE  ■>  (  R(1..2), 

STRING_TO_INT  (  R(3..6)  ), 

R  (7)  )  , 

DESCRIPTION  «>  R  (8. .37), 

QUANTITY  *> 

STRING  TO  INT  (  R(38..43)  )  ) 


end  CONVERT; 


RECORD  AGGREGATE 


ITEM_CODE  :  record 

PREFIX  :  STRING  (1..2); 

NUMBER  :  range  0..9_999; 

SUFFIX  :  CHARACTER; 
end  record; 

A  record  aggregate  denotes  a  value  constructed 
from  component  values. 


NEW_ITEM  :  ITEM_COD£ ;  —  object  declaration 

NEW  ITEM  :=  (  "CT"  ,  2493  ,  'N'  )  —  assignment 


NEW  ITEM 


- , - , - 

CT  |  2493  |  N 

_ I _ I 


position  -  textual  order 


NEW_ITEM  :*  {  NUMBER  *>  2493,  PREFIX  =>  "CT", 

SUFFIX  «>  'N'  ) 


named  components 
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RECORD  AGGREGATE 


—  named  component 
(ITEM_CODE  «> 

—  positional 
(  R(l.  .2)  , 

STRING_TO_INT (  R(3..6)), 
R(7))  , 


—  named  component 

DESCRIPTION  =>  R (8 . . 37)  , 

array  slice 


--  named  component 

SOURCE  *>  STRING_TO_INT(  R(38..43)  ) 

array  slice 


-  PREFIX 

-  NUMBER 

-  SUFFIX 


CHARACTER  INPUT-OUTPUT 


The  package  TEXT__IO  contains  the  definition  of  all  the  text 
input-output  primitives. 

It  contains  the  specifications 

procedure  GET ( ITEM  s  out  CHARACTER); 

procedure  PUT(ITEM  s  in  CHARACTER); 

procedure  PUT(ITEM  :  in  STRING); 
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WRITE_ERROR  and  WRITE_RECORD 

procedure  WRITE_ERROR  (REC  :  in  RECORD_STRING)  is 
begin 

PUT( " INVALID  DATA:  "  &  REC); 

NEW_LINE; 
end  WRITE  ERROR; 


procedure  WRITE_RECORD  (REC  :  in  ITEM_RECORD)  is 
use  RECORD_IO; 
beg  in 

case  REC. ITEM_CODE. SUFFIX  is 

when  'N '  =>  WRITE  (IMMEDIATE,  REC) 

when  'X'  I  'L'  =>  WRITE  (DEFERRED,  REC) ; 
others  =>  null; 
end  case; 


end  WRITE  RECORD; 


TEXT  FILES 


All  characters  occupy  exactly  one  column. 

Characters  of  a  file  are  considered  to  form  a  sequence 
of  lines. 


Layout  control 


LINE 

COL 


returns  current  line  number 

returns  current  column  number 


END  OF  LINE 


SKIP  LINE 


NEW  LINE 


SET  COL 


returns  TRUE  if  there  is  no  character 
left  on  the  current  input  line 
(defined  for  IN_FILE  only) 

advances  the  input  to  the  beginning 
of  the  next  line  (defined  only  for 
IN_F I LE) 

terminates  current  output  line 
(defined  only  for  OUT_FILE) 

sets  the  current  column  number 


SET_LINE_LENGTH  -  sets  the  line  length 
LINE  LENGTH  -  returns  current  line  length 
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FILE  OF  RECORDS 


A  file  is  associated  with  an  ordered  collection  of  elements, 
all  of  the  same  type. 

Let  Et  denote  an  element  of  type  T. 


i - 1 - 1 - 1  I  i  i 

|  Et  |  Et  I  Et  |  ...  I  Et  I  Et  | 

I  I  I  I  111 


In  this  example,  each  Et  is  a  record 


ITEM  CODE  | 

. . “ -  I 

PREFIX  |  NUMBER  |  SUFFIX  | 


DESCRIPTION 


|  QUANTITY 
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package  RECORD_IO  is  new 

INPUT  OUTPUT  (  ITEM  RECORD  )  ; 


INPUT_OUTPUT  is  a  standard  generic 
package  which  provides  the 
calling  conventions  for  operations 
such  as  OPEN,  CLOSE,  READ,  and 
WRITE. 

generic  (  type  ELEMENT_TYPE  ) 
package  INPUT_OUTPUT  is 
•  •  • 

procedure  WRITE  (  FILE  ;  in  OUT_FILE 

ITEM  :  in 

ELEMENT  TYPE  ) 


A  generic  package  is  a  model  which 
can  be  parameterized. 


package  RECORD_IO  is  new 


INPUT_OUTPUT  (  ITEM_RECORD  ) 

\/ 

parameter 


generic  instantiation 

obtains  a  copy  (instance) 
of  the  model  with  actual 
parameter  ITEM_RECORD 
substituted  for  the 
generic  formal  parameter 


ELEMENT  TYPE 


IMMEDIATE, DEFERRED  :  RECORD_IO. OUT_FILE 

OUT_FILE  is  a  file  type  with 
write-only  access 

it  is  declared  in  the  package 
INPUT_OUTPUT 

it  is  instantiated  within 


RECORD  10 


OPEN_FILES  and  CLOSE_FILES 

?  4 

The  generic  standard  package  INPUT_OUTPUT  contains  the 
specifications 

procedure  CREATE  (FILE  :  iji  out  OUT^FILE; 

NAME  :  in  STRING); 

which  establishes  a  new  external  file  associates  the  given 
file  with  it;  this  association  "opens"  the  file,  and 

procedure  CLOSE(FILE  :  in  out  OUT_FILE)  ; 

which  breaks  the  association. 


procedure  OPEN_FILES  is 
use  RECORD_IO; 
begin 

CREATE  (IMMEDIATE,  "external  file  name"); 
CREATE  (DEFERRED,  "external  file  name"); 
end  OPEN  FILES, 


procedure  CLOSE_FILES  is 
use  RECORD__IO; 
begin 

CLOSE  (IMMEDIATE); 
CLOSE  (DEFERRED) ; 
end  CLOSE  FILES; 
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PROGRAM  STRUCTURE 


Packages  are  a  versatile  feature  used  in 
a  number  of  ways  in  the  construction  of 
Ada  programs. 

Packages  allow  for  the  specification  of  groups 
of  logically  related  entities: 

.  pools  of  common  data  and  associated 
type  declarations 

.  groups  of  related  subprograms  (either 

within  a  single  program  or  as  a  subprogram 
library) 

.  a  type  declaration  along  with  subprograms 
to  serve  as  operators  on  the  type 
(data  abstraction) 

The  separation  of  a  package  body  from  its 
specification  provides  an  important 
information  hiding  capability. 

j 


r 
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GROUPS  OF  TYPE  AND  OBJECT 
DECLARATIONS 

package  WORK_DATA  is 

type  DAY  is  (MON,TUE,WED,THU,FRI,SAT,SUN) 
type  HOURS  is  INTEGER  range  0..2400; 
type  TIM E_T ABLE  is 

array  (MON.. SUN)  of  HOURS; 

WORK_HOURS  :  TIM E_T ABLE; 

NORMAL_HOURS  s  constant  TIMEJTABLE 

(  MON.. THU  *>  850/  PRI  =>  600/ 

SAT  |  SUN  *>  0  )  ; 


end  WORK  DATA; 


VISIBILITY 


procedure  EXAMPLE  ... 
package  WORK_DATA  is 

e  e  • 

end  WORK_DATA; 

e  e  e 

Identifiers  declared  within  WORK_DATA 
can  be  used  here,  denoted  by 
selected  components 

Examples  of  legal  references: 
WORKDATA.DAY 
WORK  DATA. WORK  HOURS 


end  EXAMPLE; 


WORK_DATA  and  its  components  are  not 
visible  outside  of  EXAMPLE. 


t* 

\  \ 


I 
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USE  CLAUSE 


procedure  EXAMPLE  ... 
package  WORK  DATA  is 


end  WORK_DATA ; 

•  •  • 

procedure  P2  ... 

•  •  • 

use  WORK  DATA; 


Identifiers  declared  within  WORK_DATA 
are  now  directly  visible. 

Examples  of  legal  references: 
TIME_TABLE 
NORMAL  HOURS 


end  P2 ; 

The  use  clause  is  no  longer  effective 
outside  of  P2,  so  selected  component 
notation  must  again  be  used  to  reference 
the  objects  defined  within  WORK_DATA. 


end  EXAMPLE; 


WORK_DATA  and  its  components  are  again 
not  visible  at  this  point. 


I 


f 


i: 
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t 


procedure  MAIN  is 


package  WORK  DATA  is 


NORMAL  HOURS  :  constant  TIME  TABLE 
:«  IMON..THU  «>  850, FRI  ->  600, 
SAT  |  SUN  ->  0); 
end  WORK_DATA; 

procedure  A  is 

use  WORK  DATA; 


NORMAL_HOURS  !  INTEGER; 

•  •  • 

—  NORMAL__HOURS  refers  to  the  integer; 

—  it  cannot  be  hidden  by  the 

—  the  same  identifier  declared 

—  in  the  package. 


—  The  use  clause  makes  all  identifiers 

—  in  the  package  directly  visible 

—  except  for  the  identifier  NORMAL  HOURS. 


—  It  can  only  be  denoted  as  a 
—  selected  component,  that  is, 
—  WORK_DATA. NORMAL_HOURS  (...) 

end  A; 
end  MAIN; 
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STRUCTURE  OP  EXAMPLE  III 


procedure  PROCESS  RECORDS  is 


package  RECORD  HANDLER  is 


end  RECORD  HANDLER; 


use  RECORD  HANDLER; 
ITEM  ;  ITEM  RECORD; 


package  body  RECORD  HANDLER  is 


end  RECORD  HANDLER; 


beg  in 


end  PROCESS  RECORDS 


procedure  PROCESS_RECORDS  is 


package  RECORD_HANDLER  is 

—  type  &  variable  declarations 

—  subprogram  specifications 
end  RECORD_HANDLER; 

use  RECORD  HANDLER; 

ITEM  s  ITEM  RECORD; 

—  variable  declaration 


package  body  RECORD_HANDLER  is 

—  type  &  variable  declarations 

—  subprogram  bodies 
end  RECORD  HANDLER; 


beg  in 


end  PROCESS  RECORDS 


procedure  PROCESS  RECORDS  is 


package  RECORD_HANDLER  is 

—  package  specification 

—  visible  part 
end  RECORD_HANDLER; 

use  RECORD  HANDLER; 

ITEM  s  ITEM_RECORD; 

—  variable  declaration 


package  body  RECORD_HANDLER  is 

—  package  body 

—  entities  not  accessible 

—  outside  the  package 

end  RECORD  HANDLER; 


beg  in 


end  PROCESS  RECORDS; 
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PROGRAM  - 

COMPILATION 


Compilation 
are  said  to 


SEPARATE  COMPILATION 


collection  of  one  or 
more  compilation  units 

UNIT  - 

.  subprogram  body 
.  package  specification 
.  package  body 

units  of  a  program 
belong  to  a 


PROGRAM  LIBRARY 


•  '  - 


SEPARATE  COMPILATION 
Version  1 


procedure  PROCESS_RECORDS  is 

package  RECORD_HANDLER  is 

—  contains  type  declarations 

—  and  subprogram  specifications 
end  RECORDJHANDLER ; 

use  RECORD  HANDLER; 

ITEM  :  ITEfi_RECORD; 

package  body  RECORD_HANDLER 
is  separate; 

beg  in 

end  *  PROCESS  RECORDS; 


The  package  body  is  to  be  compiled 
separately. 


separate  (  PROCESS_RECORDS  ) 
with  TEXT_IO; 

package  body  RECORD_HANDLER  is 

—  local  declarations 

—  subprogram  bodies 

end  RECORD  HANDLER; 


COMPILATION  OF  PACKAGE  BODY 


separate  (PROCESS_RECORDS) 
with  TEXT_IO; 

package  body  RECORD  HANDLER  is 


—  local  declarations  and  the  bodies 

—  of  the  subprograms  declared  in 

—  the  specification  part  are  found 

—  in  the  package  body 


end  RECORD_HANDLER; 

The  with  clause  indicates  that  the  package 
TEXT_IO  will  be  used  in  this  package  body. 

The  separate  clause  says  that  the  specifications 
for  this  package  can  be  found  in  the  program 
unit  named  PROCESS__RECORDS.  Identifiers 
visible  at  the  point  of  the  separate  declaration 
in  PROCESS__RECORDS  are  also  visible  in  the 
package  body. 
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SEPARATE  COMPILATION 


Version  2 

Three  program  units 

1.  package  specification 

2.  subprogram  (program) 

3.  package  body 

Each  compiled  separately. 

Package  specification  must 
be  compiled  first. 

Procedure  and  package  body 
may  be  compiled  (and 
recompiled)  in  any  order. 

The  package  body  is  no  longer 
within  PROCESS_RECORDS ,  So 
no  separate  clause  is  used. 
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SEPARATE  COMPILATION 
Version  3 


package  RECORD  HANDLER  is 

—  type  declarations  and 

—  subprogram  specifications 
•  •  • 

end  RECORD  HANDLER; 


with  RECORD_HANDLER ; 
procedure  PROCESS_RECORDS  is 
use  RECORD_HANDLER; 

•  •  • 
beg  in 
•  •  • 

end  PROCESS  RECORDS; 


with  TEXT_IO; 

package  body  RECORD_HANDLER  is 
use  TEXT_IO; 

—  declaration  of  entities 

—  not  accessible  outside 

—  package  body  and 

—  subprogram  bodies 
•  •  • 

function  VALID_RECORD  ... 

return  BOOLEAN  is  separate; 

•  • 

end  PROCESS  RECORDS; 


separate  (  RECORD_HANDLER  ) 
function  VALID_RECORD  ...  is 
•  •  • 

end  VALID  RECORD 
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SEPARATE  COMPILATION 


Version  3 

Within  the  body  of  RECORD_HANDLER , 

the  separate  compilation  of  a  subprogram 

within  another  program  unit  is  illustrated. 

function  VALID_RECORD  {  REC  :  in  RECORD_STRING  ) 
return  BOOLEAN  is  separate; 


The  body  of  this  function  would  be  compiled 
as  a  fourth  compilation  unit.  It  must  be 
compiled  after  the  body  of  RECORD_HANDLER 
(and  recompiled  any  time  that  body  is  recompiled) . 

separate  (RECORD_HANDLER) 
function  VALID_RECORD  ...  is 

end  VALID  RECORD; 
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Example  III 
Final  Version 


package  RECORD  HANDLER  is 
type  ITEM_RECORD  is 
record” 

ITEM  CODE  :  record 

PREFIX  :  STRING (1. .2} ; 

NUMBER  :  range  0..9  999; 

SUFFIX  :  CHARACTER 
end  record; 

DESCRIPTION  :  STRING (1 .. 30) ; 

SOURCE  :  range  0..999_999; 
end  record; 
procedure  OPEN  FILES; 
procedure  CLOSE  FILES; 

procedure  GET_VKLID_RECORD  (REC  :  out  ITEM_RECORD; 

END_OF  DATA  :  out  BOOLEAN); 
procedure  WRITE  RECORD  (REC  :  in  ITEM  RECORD); 
end  RECORD  HANDLER^  ” 


with  RECORD_HANDLER; 
procedure  PROCESS_RECORDS  is 

use  RECORD_HANDLER; 

ITEM  ;  ITEM_RECORD;  —  defined  in  RECORD_HANDLER 
NO_MORE_RECORDS  ;  BOOLEAN  :=  FALSE; 

beg  in 

OPEN_FILES; 

loop 

GET_VALID_RECORD  (ITEM,  NO_MORE  RECORDS); 
exit  when“NO_MORE_RECORDS; 

WRITE_RECORD  (ITEM); 
end  loop” 

CLOSE_FILES; 
end  PROCESS  RECORDS; 
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with  TEXT_IO; 

package  body  RECORD_HANDL£R  is 
use  TEXT  10; 

subtype  'RECORD  STRING  is  STRING  (1..43); 

package  REC0RD~I0  is  new  INPUT_OUTPUT  ( ITEM_RECORD) ; 

IMMEDIATE,  DEFERRED  :  REC0RD_I0_.  0UT_FILE; 

procedure  OPEN_FILES  is 
use  REC0RD_I0; 
beg  in 

CREATE  (IMMEDIATE,  "external  file  name"); 

CREATE  (DEFERRED,  "external  file  name"); 
end  OPEN_FILES; 

procedure  CLOSE__FILES  is 
use  RECORD_IO; 
begin 

CLOSE  (IMMEDIATE); 

CLOSE  (DEFERRED) ; 
end  CLOSE_FILES; 

procedure  GET_NEXT_RECORD  (REC  :  out  RECORD_STRING; 

VALID  LENGTH, 

END_OF_DATA  s  out  BOOLEAN)  is 

I  !  NATURAL; 
beg  in 

if  CHARACTER_IO.END_OF_FILE  then 
END_OF_DATA  :*  TRUE; 
else 

END_OF_DATA  :=  FALSE; 

I  J*  0; 

while  not  END_0F  LINE  and  I  <  43  loop 
I  :*  I  +  1;  ~ 

GET  (REC(I)); 
end  loop; 

VALID_LENGTH  :=  I  =  43  and  END_LINE; 

if  not  END_0F_LINE  then 
SKIP  LINE; 

—  advances  input  to  beginning 

—  of  next  line 
end  if; 

end  i f ; 

end  GE  T_N  E  XT__R  EC  OR  D ; 

function  VALID__RECORD  (REC  :  in  RECORD^STRING) 
retutn  BOOLEAN  is  separate; 
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procedure  WRITE_RECORD  (REC  :  in  ITEM_RECORD)  is 
use  RECORD_IO; 
begin  — 

case  REC. ITEM_CODE. SUFFIX  of 

when  'N'  =>  WRITE  (IMMEDIATE,  REC); 

when  'X'  |  'L'  =>  WRITE  (DEFERRED,  REC); 
others  =>  null; 
end  case; 
end  WRITE_RECORD; 

procedure  WRITE_ERROR  (REC  :  in  RECORD_STRING)  is 
begin 

PUT ( " INVALID  DATA:  "  &  REC); 

NEWSLINE ; 
end  WRITE_ERROR; 

function  CONVERT  (R  :  RECORD_STRING)  return  ITEM_RECORD  is 

function  STRING  TO_INT  (S  :  STRING)  return  INTEGER  is 
VALUE  :  INTEGER  :«  0; 
begin 

for  I  in  S'FIRST. .S'LAST  loop 

VALUE  :=  10  *  VALUE  +  CHARACTER • POS (S ( I) )  - 

CHARACTER' POS  (’O'); 

end  loop; 
return  VALUE; 
end  STRING_TO_INT; 

begin  —  body  of  CONVERT 

return  (ITEM  CODE  *>  (R{1..2), 

STRING_TO_INT  (R(3..6)), 

R (7) )  , 

DESCRIPTION  =>  R ( 8 . . 37)  , 

SOURCE  *>  STRING  T0_INT  (R ( 38 . . 43) ) ) ; 
end  CONVERT; 

procedure  GET  VALID  RECORD  (REC  :  out  ITEM_RECORD) ; 

END  0F_DATA  :  out  BOOLEAN)  is 

S  :  RECORD  STRING; 

LENGTH  ERR<5R  :  BOOLEAN; 
begin 
loop 

GET  NEXT  RECORD  (S  ,  LENGTH  ERROR,  END  OF_DATA) ; 
if  fND_0F_DATA  then 

returnj 

elsif  LENGTH  ERROR  or  else  not  VALID_RECORD(S)  then 
WRITE_ERR5R (S) ; 
else 

REC  :»  CONVERT (S) ; 
return ; 
end  if; 
end  loop; 

end  GET_VALID_RECORD; 
end  RECORD  HANDLER; 
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separate  (RECORD  HANDLER) 

function  VALID_RECORD  (REC  s  in  RECORD_STRING) 
return  BOOLEAN  is 

function  LETTERS  (S  :  STRING)  return  BOOLEAN  is 
begin 

for  C  in  S'FIRST. . S' LAST  loop 

if  S(C)  not  in  'A'.^Z*  and  S(C)  not  in  'a'-.'s' 
then  return  FALSE; 
end  i f ; 
end  loop; 
return  TRUE; 
end  LETTERS; 

function  NUMERALS  (S  :  STRING)  return  BOOLEAN  is 
begin 

for  C  in  S'FIRST. .S'LAST  loop 
if  S(C)  not  in  'O'. .'9'  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  NUMERALS; 

begin  —  body  of  VALID  RECORD 

if  LETTERS  (REC(1..2))  and  then  NUMERALS  (REC(3..6)) 

and  then  (REC(7)  «  'N'  or  REC(7)  <*  'L*  or  REC(7)  = 
and  then  NUMERALS  (REC( 38 . . 43) )  then 
return  TRUE 
else 

return  FALSE 
end  i f ; 

end  VALID  RECORD; 
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SUMMARY 


Packages 

Records  and  record  aggregates 
Case  statement 
Input-Output 
Program  Structure 
Visibility 

Separate  Compilation 
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I 

r 


EXAMPLE  IV 


ENUMERATION  TYPES 


OBJECTIVES 


Enumeration  Types 


Array  Aggregates 

Named  Parameter  Association 


[ 


package  NAVIGATION  is 

type  DIRECTION  is  (  NORTH,  EAST,  SOUTH,  WEST  ); 
type  TURN  is  (  LEFT,  RIGHT,  ABOUT,  NONE  ) ; 

function  TURN_LEFT  (D  :  DIRECTION  )  return  DIRECTION; 

function  TURN_RIGHT  <D  s  DIRECTION  )  return  DIRECTION; 

function  TURN_ABOUT  (D  s  DIRECTION  )  return  DIRECTION; 

function  CHANGE  COURSE  (D  :  DIRECTION;  T  :  TURN  )  ; 

return  DIRECTION; 

function  MANEUVER  (  OLD,  NEW  :  DIRECTION  )  return  TURN; 
end  NAVIGATION; 


package  body  NAVIGATION  is 


function  TURN_LEFT  (  D  :  DIRECTION  )  return  DIRECTION  is 

—  declare  a  local  variable  to  illustrate  use 

—  of  a  single  return  at  the  end  of  the  body 

NEW_D  :  DIRECTION; 
beg  in 

case  D  of 


when 

NORTH 

=  > 

NEW 

D 

:*  WEST; 

when 

SOUTH 

*> 

NEW- 

"D 

:=  EAST; 

when 

EAST 

=  > 

NEW" 

"D 

:=  NORTH 

when 

WEST 

=  > 

NEW”D 

:=  SOUTH 

end  case; 
return  NEW_D; 
end  TURN  LEFT 
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function  TURN_RIGHT  (  D  :  DIRECTION  )  return  DIRECTION  is 

—  a  return  statement  will  appear  in  each 

—  alternative  of  the  case  statement 

beg  in 

case  D  is 

when  NORTH  «>  return  EAST; 
when  SOUTH  =>  return  WEST; 
when  EAST  «>  return  SOUTH; 
when  WEST  *>  return  NORTH; 
end  case; 

end  TURN  RIGHT; 


function  TURN_ABOUT  (  D  :  DIRECTION  )  return  DIRECTION  is 

—  look  up  answer  in  a  constant  array 

NEW_D  :  constant  array  (  DIRECTION  )  of  DIRECTION 
:*  (  NORTH  *>  SOUTH  , 

SOUTH  =>  NORTH  , 

EAST  *>  WEST  , 

WEST  *>  EAST  ) ; 

beg  in 

return  NEW_D (  D  }; 
end  TURN  ABOUT; 


function  CHANGE  COURSE  (  D  :  DIRECTION  ;  T  :  TURN  ) 

return  DIRECTION  is 

beg  in 

case  T  is 

when  LEFT  *>  return  TURN  LEFT(  D  ); 
when  RIGHT  «>  return  TURN”RIGHT(  D  ); 
when  ABOUT  »>  return  TURN~ABOUT(  D  ); 
when  NONE  »>  return  D; 
end  case; 

end  CHANGE  COURSE; 


IV. 130 


function  MANEUVER  (  OLD,  NEW  :  DIRECTION  )  return  TURN  is 
beg  in 


K 

l 


if  NEW  =  TURN_LEFT(  OLD  )  then 
return  LEFT; 

elsif  NEW  *  TURN  RIGHT(  OLD  )  then 
return  RIGHT; 

elsif  NEW  *  TURN  ABOUT (  OLD  )  then 
return  ABOUT; 

else 

return  NONE; 
end  if; 

end  MANEUVER; 


end  NAVIGATION; 


\ 


n 


i 


i 

i 

! 

I 

L 

[  IV.  240 


t 


package  NAVIGATION  is 


type  DIRECTION  is  (  NORTH,  EAST,  SOUTH,  WEST  ); 
type  TURN  is  (  LEFT,  RIGHT,  ABOUT,  NONE  ); 

function  TURN_LEFT  (D  :  DIRECTION  )  return  DIRECTION; 

function  TURN_RIGHT  (D  :  DIRECTION  )  return  DIRECTION; 

function  TURN_ABOUT  (D  :  DIRECTION  )  return  DIRECTION; 

function  CHANGE_COURSE  (D  :  DIRECTION;  T  :  TURN  ) 

return  DIRECTION; 

function  MANEUVER  {  OLD,  NEW  :  DIRECTION  )  return  TURN; 

end  NAVIGATION; 


IV. 150 


package  body  NAVIGATION  is 

function  TURN_LEFT  ...  is 
•  •  • 

end  TURN_LEFT; 

function  TURN_RIGHT  ...  is 
•  •  • 

end  TURN_RIGHT; 

function  TURN_ABOUT  ...  is 
•  •  • 

end  TURN_ABOUT; 

function  CHANG E_C OUR SE  ...  is 
•  •  • 

end  CHANG E_C OUR SE ; 

function  MANEUVER  ...  is 
•  •  • 

end  MANEUVER; 
end  NAVIGATION; 


IV.  160 


ENUMERATION  TYPES 


7 

f 

type  DIRECTION  is 

(NORTH,  EAST,  SOUTH,  WEST),* 

OLD_D,  NEWJD  :  DIRECTION; 

OLD_D  :*  NORTH; 

NEW_D  :*  OLD JD; 

Predefined  attributes; 

DIRECTION 'FIRST  *  NORTH 
DIRECTION' LAST  =  WEST 

DIRECTION 'SUCC (EAST)  *  SOUTH 
DIRECTION ' PRED ( WEST)  =  SOUTH 
DIRECTION' POS (SOUTH)  *  2 

DIRECTION ' SUCC { DIRECTION ' LAST)  —  raise  the  exception 

DIRECTION 'PRED (DIRECTION 'FIRST)  —  OBJECT  ERROR 


L 


IV. 170 


function  TURN_LEFT  (  D  :  DIRECTION  )  return  DIRECTION  is 

—  declare  a  local  variable  to  illustrate  use 

—  of  a  single  return  at  the  end  of  the  body 

NEW_D  :  DIRECTION; 
begin 


case  D  is 

when  NORTH 

=  > 

NEW  D 

:=  WEST; 

when  SOUTH 

=  > 

NEW  D 

:=  EAST; 

when  EAST 

=  > 

NEW  D 

:*  NORTH; 

when  WEST 

=  > 

NEW"D 

:=  SOUTH; 

end  case; 

return  NEW_D; 
end  TURN  LEFT; 


function  TURN_RIGHT  (  D  ;  DIRECTION  )  return  DIRECTION  is 

—  a  return  statement  will  appear  in  each 

—  alternative  of  the  case  statement 


beg  in 

case  D  is 

when  NORTH 
when  SOUTH 
when  EAST 
when  WEST 
end  case; 


=>  return  EAST; 
*>  return  WEST; 
=>  return  SOUTH; 
=>  return  NORTH; 


end  TURN  RIGHT; 


The  order  relations  between  enumeration  values  follow  the 
order  of  listing: 


NORTH  <  EAST  <  SOUTH  <  WEST 


for  D  in  NORTH  ..  WEST  loop 


end  loop; 


for  D  in  DIRECTION ' F IRST  ..  DIRECTION • LAST  loop 


end  loop; 


IV. 190 


Alternate  solution  to  TURN__RIGHT 

function  TURN_RIGHT  (D  :  DIRECTION)  return  DIRECTION  is 
begin 

if  D  ■  DIRECTION* LAST  then 
return  DIRECTION 'FIRST; 
else 

return  DIRECTION* SUCC(D) ; 
end  if; 

end  TURN  RIGHT; 


IV. 200 


function  TURN_ABOUT  (  D  s  DIRECTION  )  return  DIRECTION  is 

—  look  up  answer  in  a  constant  array 

NEW  D  s  constant  array  (  DIRECTION  )  of  DIRECTION 
”  :*  (  NORTH  =>  SOUTH  , 

SOUTH  *>  NORTH  , 

EAST  =>  WEST  , 

WEST  ■>  EAST  ); 


begin 

return  NEW_D(  D  ); 
end  TURN  ABOUT; 


IV. 210 


ARRAY  INDEXED  BY 


ENUMERATION 

function  TURN_ABOUT  (  D  :  DIRECTION  ) 

return  DIRECTION  is 

NEW_D  :  constant  array  (DIRECTION)  of  DIRECTION 
:=  (NORTH  =>  SOUTH, 

SOUTH  =>  NORTH, 

EAST  *>  WEST, 

WEST  ®>  EAST  ) j 

—  NEW_D  is  a  one-dimensional 

—  array  with  four  components 

—  Each  element  (or  component) 

—  may  take  on  one  of  the 

—  enumerated  values  of  type 
—  DIRECTION 

—  The  four  elements  are 

—  denoted  by 

NEW_D  (NORTH) 

NEW_D ( EAST) 

NEW_D (SOUTH) 

NEW  D(WEST) 


IV. 220 


ARRAY  AGGREGATES 

NEW_D  :  constant  array  (DIRECTION) 
of  DIRECTION 

:=  (  NORTH  =>  SOUTH, 

SOUTH  «>  NORTH, 

EAST  *>  WEST, 

WEST  ■>  EAST  )  , 

—  NEW_D (NORTH)  =  SOUTH 

—  NEW_D (SOUTH)  *  NORTH 

—  NEW_D (EAST)  -  WEST 

—  NEW_D (WEST)  *  EAST 

begin 

return  NEW_D  (D) ; 
end  TURN  ABOUT; 


An  aggregate  denotes  an  array  constructed  from  component 
values . 


Examples  : 

type  TABLE  is  array  (1..10)  of  INTEGER; 
A  :  TABLE  :*  ( 7, 9, 5, 1 , 3 *2, 4, 8, 6,0) ; 


A(l)  -  7 
A(2)  -  9 
A(3)  «  5 
•  •  • 

A( 10)  -  0 


expressions  which  define 
the  values  to  be 
associated  with 
components  given  by 
position  (index 
order  for  array 
components) 


IV. 240 


B  :  TABLE 


(5/4, 8,1,  others  ■>  20); 

\ _  _ / 

positional 


B(l)  -  5 
B{ 2)  -  4 
B(3)  *  8 
B  ( 4 )  -  1 

B( 5)  thru  B( 10)  *  20 


C  s  TABLE  :*  (  2  |  4  |  10  *>  1,  others  »>  0  ); 

\  / 
x/ 

named 

components 

C(l)  *  0 
C(2)  *  1 
C(3)  «  0 
C  (  4 )  =  1 

C( 5)  thru  C( 9)  -  0 
C(10)  *  1 

An  aggregate  must  provide  values  for  all  components. 

The  choice  "others"  stands  for  all  components  not  specified 
by  previous  choices. 

If  used,  "others"  must  appear  last. 


IV. 250 


type  MATRIX  is  array  (INTEGER  range  <>,  INTEGER  range  <>) 


OF  FLOAT; 


NULL_MATRIX  :  constant  MATRIX 

:*  (  1. .10  =>  (1. .10  =>  0.0)  )  ; 


An  aggregate  can  be  used  to  give  values  to 
provide  bounds  for  an  array  object.  In 
choice  "others"  cannot  be  used. 

An  aggregate  for  an  n-dimensional  array  is 
dimensional  aggregate  of  components 
dimensional  array  values. 


components  and  to 
this  case,  the 

written  as  a  one- 
that  are  (n-1)- 


IV. 260 


function  CHANGE  COURSE  (  D  :  DIRECTION  ;  T  :  TURN  ) 

return  DIRECTION  is 

begin 

case  T  is 

when  LEFT  =>  return  TURN_LEFT(  D  ); 
when  RIGHT  ■>  return  TURN_RIGHT(  D  ); 
when  ABOUT  *>  return  TURN”ABOUT(  D  ); 
when  NONE  *>  return  D;  “ 
end  case; 

end  CHANGE  COURSE; 


IV. 270 


I 

I 

[ 


function  MANEUVER  (  OLD,  NEW  :  DIRECTION  )  return  TURN  is 
beg  in 

if  NEW  »  TURN_LEFT<  OLD  )  then 
return  LEFT; 

elsif  NEW  «  TURN  RIGHT{  OLD  )  then 
return  RIGliT; 

elsif  NEW  «  TURN  ABOUT <  OLD  )  then 
return  ABOUT; 

else 

return  NONE; 
end  if; 

end  MANEUVER; 


IV. 280 


NAMED  PARAMETER  ASSOCIATION 


CURRENT  DIRECTION,  NEXT  DIRECTION  :  DIRECTION; 


Equivalent  subprogram  calls: 

MANUEVER  (OLD  *>  CURRENT_DIRECTION , 
NEW  «>  NEXT_DIRECTION) ; 

MANEUVER  (NEW  =>  NEXT_DIRECTION , 

OLD  =>  CURRENT  DIRECTION) ; 


Form 


formal_parameter  =>  actual  parameter 


IV. 290 


ADDITIONAL 
EXAMPLES 
OF  THE  USE  OF 
ENUMERATION 
TYPES 


IV. 300 


type  MONTH_NAME  is 

(  JANUARY,  FEBRUARY,  MARCH,  APRIL,  MAY,  JUNE,  JULY, 
AUGUST,  SEPTEMBER,  OCTOBER,  NOVEMBER,  DECEMBER  ); 

MONTH  :  MONTH_NAME  ; 

if  MONTH  =  DECEMBER  and  Day  =  31  then 

MONTH  :=  JANUARY  ; 

DAY  :=  1  ; 


YEAR  :=  YEAR  +  1  ; 


type  MONTH_NAME  is  (...)  ; 

NUMBER__OF_DAYS  :  constant  array  (  MONTH_NAME  )  of  INTEGER 
:  =  (  APRIL  |  JUNE  |  SEPTEMBER  | 

NOVEMBER  =>  30, 

FEBRUARY  =>  28, 
others  =>  31  )  ; 


if  DAY  =  NUMBER_OF_DAYS  {  MONTH  )  then  I 

DAY  :=  1  ;  \ 

if  MONTH  *  DECEMBER  then 
MONTH  :=  JANUARY  ; 

YEAR  :=  YEAR  +  1  ; 
else 

MONTH  :=  MONTH_NAME' SUCC  (  MONTH  )  j 
end  if  ; 
el  se 

DAY  :=  DAY  +  1  ; 


end  if 


9 


—  use  of  an  enumeration  as  a  state  indicator 


function  FIND_CHAR  (  S  :  STRING;  C  s  CHAR  ) 

return  NATURAL  is 

—  function  to  find  the  position  of  the  first 

—  occurence  of  a  character  C  in  a  string  S; 

—  returns  S'  LENGTH  +  1  if  C  is  not  present; 
—  ASSUMES  S  IS  NOT  NULL! 

STATE  :  (  SEARCHING,  FOUND,  NOTPRESENT  ); 

POS  :  NATURAL  range  1.. S' LENGTH; 

beg  in 

STATE  :=  SEARCHING; 

POS  :=  1;  —  assumes  S  is  not  null 

loop 

if  S(POS)  *  C  then 
STATE  :=  FOUND; 
elsif  POS  =  S' LENGTH  then 
STATE  :*  NOTPRESENT; 

else 

POS  :=  POS  +  1; 
end  i f  ; 

exit  when  STATE  /«  SEARCHING; 
end  loop; 

if  STATE  »  FOUND  then 
return  POS; 

else  —  STATE  =  NOTPRESENT 
return  S ' LENGTH  +  1; 
end  if; 


end  FIND  CHAR; 


begin 


STATE  :=  SEARCHING  ; 

loop 

if  ...  then 

•  •  • 

end  if; 

exit  when  STATE  /=  SEARCHING  ; 

end  loop  ; 


IV. 340 


I 

I 

i: 


within  the  loop 


if 


S(  POS  )  =  C  then 


| 

!  STATE  :=  FOUND  ; 

) 

elsif  POS  ■  S' LENGTH  then 

STATE  :*  NOTPRESENT  ; 


else 


POS  :*  POS  +  1  ; 


end  i f  i 


i 

t 

i 

I 


IV. 350 


upon  exit  from  loop 


I 

l 

j  if  STATE  -  FOUND  then 

|  *  •  return  POS  ; 

i  i 

!. 

|  else  —  STATE  *  NOTPRESENT 

!  i- 

I  return  S' LENGTH  +  1  ; 

I 

|  i. 

i 

>  end  if  ; 

! 

r 

i. 


i 


i: 

E 


IV. 360 


—  This  function  compares  two  strings,  which  may  not  be  of  equal 

—  length.  Two  strings  are  equal  if  they  match  through  the  length 

—  of  the  shorter  string  and  the  longer  string  is  blank  filled 

—  beyond  that  point. 

function  STRING_EQUAL  (SI,  S2  :  STRING)  return  BOOLEAN  is 
type  SEARCH_STATE  is 

(EQUAL,  NOT_EQUAL,  Sl_LONGER,  S2_L0NGER,  CHECKING); 

STATE  :  SEARCH_STATE  :=  CHECKING; 

INDEX  :  INTEGER  range  1. .MAX (SI* LENGTH, S2* LENGTH)  :*  1; 


IV. 370 


EQUAL  STRINGS 


STRING_EQUAL  (  "BEST"  ,  "BEST*  ) 
STR I NG_E QU A L  (  "BEST"  ,  "BEAT"  ) 

STRING_EQUAL  (  "BET"  ,  "BETTER"  ) 
STRING_EQUAL  (  "BET  "  ,  "BET  "  ) 

STRING  EQUAL 


—  TRUE 

—  FALSE 

—  FALSE 

—  TRUE 

—  TRUE 


function  BLANKS  (S  :  STRING)  return  BOOLEAN  is 


—  Returns  true  only  for  a  string  of  all  blanks 
beg  in 

for  I  in  1..  S'  LENGTH  loop 
if  S(I)  /*  •  •  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  BLANKS; 


) 


IV. 390 


I 


I 


begin 

—  first  check  for  null  strings 
if  SI’ LENGTH  *  0  then 
if  S2' LENGTH  -  0  then 
STATE  :=  EQUAL; 
else 

STATE  :  =  S2_L0NGER; 
end  if; 

elsif  S2' LENGTH  =  0  then 
STATE  t-  S1_L0NGER; 
end  if;  ' 


—  check  the  strings  character  by  character 
while  STATE  *  CHECKING  loop 

if  SI (INDEX)  /-  S2(INDEX)  then 
STATE  :*  NOT_EQUAL; 
elsif  INDEX  *  sl' LENGTH  then 
if  INDEX  »  S2' LENGTH  then 
STATE  :=  EQUAL; 
else 

STATE  :*  S2_L0NGER; 
end  if; 

elsif  INDEX  *  S2 ' LENGTH  then 
STATE  :=  S1_L0NGER; 
end  if; 

INDEX  :=  INDEX  +  1; 
end  loop; 


—  return  with  value  based  on  current  state 
case  STATE  is 

when  EQUAL  *>  return  TRUE; 
when  NOT  EQUAL  *>  return  FALSE; 

when  SI  CONGER  =>  return  BLANKS (S 1 ( INDEX. . SI ’ LENGTH) ) ; 
when  S2"LONGER  *>  return  BLANKS (S2 (INDEX. .S2 'LENGTH) ) ; 
when  CHECKING  ■>  null;  —  this  branch  is  unreachable 
end  case; 
end  STRING  EQUAL; 


i: 

£ 


IV. 400 


—  This  function  compares  two  strings,  which  may  not  be  of  equal 

—  length.  Two  strings  are  equal  if  they  match  through  the  length 

—  of  the  shorter  string  and  the  longer  string  is  blank  filled 

—  beyond  that  point. 

function  STRING  EQUAL  (SI,  S2  :  STRING)  return  BOOLEAN  is 
type  SEARCH_jTATE  is 

(EQUAL,  NOT  EQUAL,  SI  LONGER,  S2  LONGER,  CHECKING) ; 

STATE  s  SEARCH  STATE  :*  CHUCKING; 

INDEX  :  INTEGER  range  1. . MAX (SI1 LENGTH, S2* LENGTH)  :=  1; 


function  BLANKS  (S  :  STRING)  return  BOOLEAN  is 

—  Returns  true  only  for  a  string  of  all  blanks 
beg  in 

for  I  in  1..  S'  LENGTH  loop 
if  S(I)  /=  •  '  then 
return  FALSE; 
end  if; 
end  loop; 
return  TRUE; 
end  BLANKS; 


beg  in 

—  first  check  for  null  strings 
if  SI 'LENGTH  *  0  then 

if  S2' LENGTH  =  0  then 
STATE  s=  EQUAL; 
else 

STATE  :=  S2_L0NGER; 
end  i f ; 

elsif  S2' LENGTH  *  0  then 
STATE  :=  S1JL0NGER; 
end  if; 

—  check  the  strings  character  by  character 
while  STATE  *  CHECKING  loop 

if  SI  (INDEX)  /=  S 2 ( I NDEX)  then 
STATE  :=  NOT  EQUAL; 
elsif  INDEX  *  ST' LENGTH  then 
if  INDEX  «  S2' LENGTH  then 
STATE  :*  EQUAL; 
el  se 

STATE  :*  S2_L0NGER; 
end  if; 

elsif  INDEX  *  S 2 ' LENGTH  then 
STATE  :*  S1_L0NGER; 
end  if; 

INDEX  :«  INDEX  +  1; 
end  loop; 


IV. 410 


—  return  with  value  based  on  current  state 
case  STATE  is 

when  EQUAL  «>  return  TRUE; 
when  NOT  EQUAL  «>  return  FALSE; 

when  SI  ZTONGER  =>  return  BLANKS  (SI  (INDEX.  .SI  'LENGTH) )  ; 
when  S2~L0NGER  «>  return  BLANKS (S2 (INDEX. .S2 • LENGTH) ) ; 
when  CHECKING  *>  null;  —  this  branch  is  unreachable 
end  case; 
end  STRING  EQUAL; 


IV. 420 


SUMMARY 


Enumeration  Types 
Array  Aggregates 


Named  Parameter  Association 


EXAMPLE  V 


OVERLOADING 


and 


EXCEPTIONS 


V.  100 


I 

I 

I 

!. 

i. 

*-  OBJECTIVES 

1. 

j  Overloading 

|  Exceptions 

r 

i  Packages  and  Exceptions 


i: 

[ 


v.  no 


package  MATRIX  OPS  is 

type  MATRIX  is  array  (INTEGER  range  <>,  INTEGER  range  <>) 

Of  FLOAT; 


function 

( 

A  : 

FLOAT;  M  :  MATRIX  ) 

return  MATRIX; 

function 

( 

Ml , 

M2  :  MATRIX  )  return 

MATRIX; 

function 

»*» 

( 

A  : 

FLOAT;  M  :  MATRIX  ) 

return  MATRIX; 

function 

«*» 

( 

Ml, 

M2  :  MATRIX  )  return 

MATRIX; 

end  MATRIX  OPS; 


package  body  MATRIX_OPS  is 

function  "+"  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 

TEMP  :  MATRIX (  M ' FIRST ( 1) . .M • LAST ( 1)  ,  M'FIRST (2) . .M ’ LAST (2)  ); 

beg  in 

for  I  in  M'FIRST  ..  M' LAST  loop 

for  J  in  M ' FIRST (2)  ..  M’LAST(2)  loop 

TEMP (I ,  J)  : =  A  +  M( I , J) ; 
end  loop; 
end  loop; 

return  TEMP; 

end  "+"; 


V.  120 


function  "+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 


TEMP  :  MATRIX (  MI 'FIRST. .Ml'LAST,  Ml ' F IRST ( 2) . .Ml ' LAST ( 2)  ); 
IOFFSET,  JOFFSET  :  INTEGER; 

beg  in 

IOFFSET  :*  M2'FIRST(1)  -  Ml'FIRST(l); 

JOFFSET  :«  M2 'FIRST (2)  -  M1'FIRST(2); 

for  I  in  Ml ' F IRST ( 1 )  ..  Ml'LAST(l)  loop 
for  J  in  Ml 'FIRST (2)  ..  M1'LAST{2)  loop 

TEMP ( I ,  J)  : •  Ml  ( I ,  J)  +  M2 (I  +  IOFFSET,  J  +  JOFFSET); 
end  loop; 
end  loop; 

return  TEMP; 

end 


function  (  A  s  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 

TEMP  j  MATRIX {  M 'FIRST ( 1)  . .M *  LAST (1)  ,  M 'FIRST (2)  . .M ' LAST ( 2)  ) 

beg  in 

for  I  in  M'FIRST(l)  ..  M'LAST(l)  loop 
for  J  in  M 'FIRST (2)  ..  M'LAST(2)  loop 
TEMP (I , J)  :*  A  *  M( I , J) ; 
end  loop; 
end  loop; 

return  TEMP; 

end  ; 


V.  130 


function  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 

TEMP  s  MATRIX{M1'FIRST(1) . .Ml'LAST(l) ,  M2'FIRST(2) . .M2'LAST(2)  ); 
OFFSET  :  constant  INTEGER  :=  M2'FIRST(1)  -  M1'FIRST(2); 

beg  in 

for  I  in  Ml'FIRST(l)  ..  M1*LAST(1)  loop 
for  J  in  M2 'FIRST (2)  ..  M2 'LAST (2)  loop 
TEMP(I , J)  :*  0.0; 

for  K  In  M1'FIRST(2)  ..  M1'LAST(2)  loop 

TEMP ( I , J)  :■  TEMP ( I , J)  +  M1(I,K)  *  M2(K  +  OFFSET,  J)  ; 
end  loop; 
end  loop; 
end  loop; 

return  TEMP; 

end 

end  MATRIX  OPS; 


V.  140 


package  MATRIX_OPS  is 

type  MATRIX  is  array  (  INTEGER  range  <>,  INTEGER  range  <>) 
of  FLOAT; 

function  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX; 

function  •+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX; 
function  (  A  :  FLOAT;  M  s  MATRIX  )  return  MATRIX; 

function  {  Ml,  M2  :  MATRIX  )  return  MATRIX; 

end  MATRIX  OPS; 


V.  150 


OVERLOADING  OF  OPERATIONS 

package  MATRIX_OPS  is 
•  •  • 

function  "+"  (  A  :  FLOAT,  M  s  MATRIX  ) 
return  MATRIX; 

function  "+"  (  Ml,  M2  :  MATRIX  ) 
return  MATRIX; 

•  •  • 

end  MATRIX_OPS; 

A  function  named  by  a  character  string  is  used  to  define 
additional  meaning  for  an  operator 


V.  160 


+  defined  for  any  numeric  type 
(  integer  and  real  ) 

new  meaning  : 

scalar  +  matrix 

matrix  +  matrix 


.  character  string  must  denote 
one  of  operators  in  language 

.  +  and  -  permitted  for  unary 
and  binary  operators 

.  *  and  /  permitted  for  binary 
operators 

.<,>,<*»>*  can  be 
overloaded;  result  must 
be  type  boolean 


V.  170 


use  of  MATRIX  OPS 


declare 

use  MATRIX_OPS; 

A,  B  :  MATRIX {  1..10,  1..20); 

C  :  MATRIX(11. .30,  1..30); 

D,  E  :  MATRIX {  1..10,  1..30); 

X,  Y  :  FLOAT; 
beg  in 

—  assume  initialization  done  here 
A  :*  X  +  B  ;  —  first  “+" 

A  :*  3.5  +  B  ;  —  first 

A  :■  A  +  B  ;  —  second  "+" 

C  :*  Y  *  C  ;  —  first 

D  :=  -9.7  *  E  ;  —  first 

E  :*  A  *  C  ;  —  second  **" 

E  :*=D  +  (A  +  B)  *  (5.25  *  C  )  ; 

A  :*  A  +  1.0  ;  —  error  :  there  is  no  such 

•+"  operation 


end 


—  of  example  of  usage 


function  "+"  (As  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 


I 

I 

I 

I 

[ 


i: 


TEMP  :  MATRIX(  M' FIRST( 1 ) . .M' LAST ( 1 )  ,  M'FIRST(2) 
beg  in 

for  I  in  M*  FIRST  ..  M*  LAST  loop 

for  J  in  M 'FIRST (2)  ..  M'LAST{2)  loop 
TEMP(I,J)  s*  A  +  M( I f J) ; 
end  loop; 
end  loop; 


.M'LAST(2)  ) 


return  TEMP; 


end  *+"; 


i 

I 


i: 

■*  * 

i. 

i: 

L 


function  *+"  (A  :  FLOAT  ;  M  :  MATRIX)  return  MATRIX  is 


subtype  ROWS  is  INTEGER  range  M'FIRST(l)  .. 
subtype  COLS  is  INTEGER  range  M'FIRST(2)  .. 
TEMP  :  MATRIX (ROWS,  COLS); 
beg  in 

for  I  in  ROWS  loop 
for  J  in  COLS  loop 

TEMP ( I , J)  :*  A  +  M( I , J) ; 
end  loop; 
end  loop; 
return  TEMP; 


M’LAST(l) 
M' LAST (2) 


function  "+"  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 

TEMP  :  MATRIX  (  M'FIRST(l)  ..  M'LAST(l), 

M ' FIRST (2)  ..  M ' LAST (2)  ); 

beg  in 
•  •  • 

end 


will  return  TEMP;  attributes  taken  from  actual  parameters 


M ' FIRST ( i )  lower  bound  of  i-th  index 

M'LAST(i)  upper  bound  of  i-th  index 
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Object  declaration 


I 

r 

r ■ 

l 

! 

A  :  MATRIX  (-5. .5,  1..20) 

;  *  A  A  A 

I  i  I  I 

‘  till 

A' F IRST ( 1 )  —  *  |  |  | 

I  III 

i  A' LAST  (1) - '  |  | 

I  I 

A'FIRST  (2) - '  | 

I  I 

A' LAST  (2) - ' 


When  the  declaration  "TEMP  :  ..."  is  elaborated,  an  object  hav¬ 

ing  11  rows  and  20  columns  will  be  created. 


I 

l 

4 


r 


V.  220 


A  :  =  A  +  1.0;  —  SYNTAX  ERROR 

+  not  defined  for  matrix 
as  first  parameter  and 
scalar  as  second  parameter 

could  add 

function  "+"  {  M: MATRIX;  A : F LOAT  ) 
return  MATRIX  is 

begin 

return  A  +  M; 
end  "+"; 

to  MATRIX  OPS 
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function  "+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 

TEMP  :  MATRIX (  Ml 'FIRST. .Ml • LAST,  M1‘FIRST(2). 
IOFFSET,  JOFFSET  :  INTEGER; 

begin 

IOFFSET  : —  M2'FIRST(1)  -  Ml'FIRST(l); 

JOFFSET  :=  M2‘FIRST<2)  -  Ml ‘FIRST (2) ; 

for  I  in  Ml'FIRST(l)  ..  Ml'LAST(l)  loop 
for  J  in  Ml ‘FIRST (2)  ..  Ml 'LAST (2)  loop 

TEMP ( I , J)  • —  Ml ( I , J)  +  M2 (I  +  IOFFSET,  J 
end  loop; 
end  loop; 

return  TEMP; 

end  "+"; 


Ml ‘ LAST ( 2)  ) 


+  JOFFSET) ; 
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function  "+"  (Ml, M2: MATRIX)  return  MATRIX  is 


TEMP  :  MATRIX  (  Ml'FIRST. .Ml'LAST, 

Ml 'FIRST (2) ,  .Ml ' LAST (2)  ); 

indices  of  returned  matrix 
taken  from  left  operand 

Object  declarations  - 

S,T  :  MATRIX  (1. .4, 1. .6) ; 

U  :  MATRIX  (-3. .0,10.. 15) ? 

S  +  T  and  S  +  U  return  a 
4x6  matrix  with  indices 
1..4  x  1..6 

U  +  S  returns  a  4x6  matrix 
with  indices  -3..0  x  10. .15 
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discrete  range  for  loops  taken  from  first  operand 


S  +  U  for 


I  in  1..4  loop 
for  J  in  1 . . 6  loop 


U  +  S 


for  I  in  -3..0  loop 

for  J  in  10. . 15  loop 


OFFSET 


Consider  U  +  S 

_  +  JOFFSET  - 

.1 

U-3..0,10..15  +  s1..4,1..6 

I 

_  +  I OFFSET 

IOFFSET  i*  M2 'FIRST (1) 

*  1 

=  4 

JOFFSET  :=  M2'FIRST(2)  -  MI'FIRST(2) 


-  Ml 'FIRST (1) 
(-3) 


function  ■**  (As  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 


TEMP  :  MATRIX (  M' F IRST ( 1 ) . .M' LAST ( 1 ) ,  M'FIRST(2).. 
beg  in 

for  I  in  M'FIRST(l)  ..  M'LAST(l)  loop 
for  J  in  M 'FIRST (2)  ..  M'LAST(2)  loop 
TEMP( I , J)  A  *  M(I, J) ; 

end  loop; 
end  loop; 

return  TEMP; 

end  ; 


M* LAST (2)  ); 


1 
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i 


function  "**  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 


TEMP  s  MATRIX (Ml ' FIRST ( 1 ) ..Ml'LAST(l) ,  M2 ' F IRST(2) . .M2 • LAST( 2)  ); 
OFFSET  :  constant  INTEGER  s*  M2'FIRST(1)  -  M1'FIRST(2); 

beg  in 

for  I  in  Ml'FIRST(l)  ..  Ml'LAST(l)  loop 
for  J  in  M2 'FIRST (2)  ..  M2'LAST(2)  loop 
TEMP(I , J)  j*  0.0; 

for  K  in  M1'FIRST(2)  ..  M1'LAST(2)  loop 

TEMP ( I , J)  :=  TEMP(I, J)  +  M1(I,K)  *  M2(K  +  OFFSET,  J) ; 
end  loop; 
end  loop; 
end  loop; 

return  TEMP; 

end 
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MATRIX  MULTIPLICATION 


Amxn  x  Bnxp  — >  Cmxp 

Product  of  two  matrices  is 
defined  only  when  number  of 
columns  in  first  matrix  is 
equal  to  the  number  of  rows 
in  the  second. 


N 


cij  *  y  aikx  bkj 

k=l 
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function  (  Ml ,M2  :  MATRIX  )  return  MATRIX  is 

TEMP:  MATRIX  (  Ml • F IRST ( 1 ) . .Ml • LAST ( 1 ) , 

M2'FIRST(2) ..M2*LAST(2)  ); 


Object  declarations  - 

S  :  MATRIX  (1..4,1..6)  ; 

T  :  MATRIX  (1..6,1..2)  ; 

U  :  MATRIX  (1..8,1..4)  | 

S  *  T  returns  a  4x2  matrix 

with  indices  1..4  x  1..2 

U  *  S  returns  a  8x6  matrix 

with  indices  1..8  X  1..6 

T  *  S  is  undefined 
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V 


! 


EXCEPTIONS 


1 - r 

I  subprogram  specification  I  is 

I _ I _ I 


T - T 

I  declarative  part  I 

I _ I 


begin 


|  sequence_of_  I 

I  statements  I 

I  _ I 


exception 


\ 


1  T  \  optional 

I  exception  I  / 

j  handler  I  I 


/ 


end ; 


Exception  handler  defines  action  to  be  taken  when  specific  excep¬ 


tions  are  raised. 


declare 


beg  in 


exception 


end ; 


procedure 


beg  in 


exception 


end ; 
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Form  of  exception  handler 


when  exception  choices  => 

sequence  of  statements 


exception  choices  : 


exception  name 


others  —  must  appear  last 


Example  ; 


exception 


when  OB JECT_ERROR  => 

PUT 

when  OVERFLOW  |  UNDERFLOW  => 
PUT 

when  others  =  > 

PUT 
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function  "+"  (  Ml, M2  :  MATRIX  ) 
return  MATRIX  is 

•  •  • 

defined  only  if  Ml  and  M2 
have  same  number  of  rows 
and  same  number  of  columns 


function  (  Ml, M2  :  MATRIX  ) 

return  MATRIX  is 

•  •  • 

defined  only  if  number  of  columns 
of  Ml  is  equal  to  number  of 


package  MATRIX_OPS  is 

type  MATRIX  is  array  (INTEGER  range  <>,  INTEGER  range  <>) 

of  FLOAT; 

SIZE_ERROR  :  exception; 

function  "+"  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX; 

function  •+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX; 

—  may  raise  exception  SIZE_ERROR  if  Ml  and  M2 

—  are  not  the  same  size 

function  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX; 

function  "**  (  Ml,  M2  :  MATRIX  )  return  MATRIX; 

—  may  raise  exception  SIZE_ERROR  if  the  number 

—  of  columns  of  Ml  is  not  equal  to  the  number 

—  of  rows  of  M2 

end  MATRIX  OPS; 


package  body  MATRIX_OPS  is 

function  (  A  :  FLOAT;  M  ;  MATRIX  )  return  MATRIX  is 

TEMP*:  MATRIX (  M' f i r St  ( 1)  . .M *  LAST ( 1)  ,  M 'FIRST (2)  . .M ' LAST (2)  ); 

beg  in 

for  I  in  M'FIRST  ..  M' LAST  loop 

for  J  in  M ' FIRST (2)  ..  M'LAST(2)  loop 
•  TEM?  ( I ,  J)  :=  A  +  M  { I ,  J)  ; 

end  loop; 
end  loop; 

return  TEMP; 

end  "+"; 
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function  "+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 


—  may  raise  exception  SIZE_ERROR 

TEMP  :  MATRIX (  Ml ' FIRST. .Ml ' LAST,  Ml 'FIRST (2) . .Ml • LAST (2)  ); 

I OFFSET ,  JOFFSET  ;  INTEGER; 

beg  in 

if  Ml" LENGTH (1)  /«  M2' LENGTH (1)  or 
Ml 'LENGTH (2)  /=  M2' LENGTH (2)  then 
raise  SIZE_ERROR; 

end  if; 

I OFFSET  :*  M2'FIRST{1)  -  Ml'FIRST(l); 

JOFFSET  :=  M2'FIRST(2)  -  Ml 'FIRST (2) ; 

for  I  in  Ml'FIRST(l)  ..  Ml’LAST(l)  loop 
for  J  in  Ml 'FIRST (2)  ..  M1'LAST(2)  loop 

TEMP( I , J)  :»  Ml ( I , J)  +  M2 ( I  +  I OFFSET,  J  +  JOFFSET); 
end  loop; 

end  loop; 

return  TEMP; 
end  "+"; 


function  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX  is 

TEMP  :  MATRIX (  M ' FIRST (1) . .M ' LAST ( 1) ,  M • FIRST (2) . .M • LAST (2)  ) 
beg  in 

for  I  in  M'FIRST(l)  ..  M' LAST ( 1)  loop 
for  J  in  M' FIRST (2)  ..  M'LAST(2)  loop 
TEMP(  I ,  J)  :*  A  *  M(  I ,  J)  ; 
end  loop; 
end  loop; 


return  TEMP; 


function  •*"  (  Ml,  M2  :  MATRIX  )  return  MATRIX  is 
—  may  raise  exception  SIZE  ERROR 

TEMP  :  MATRIX(M1 'FIRST (1) ..Ml' LAST (1) ,  M2 'FIRST (2) . .M2 ' LAST (2)  ) 
OFFSET  :  constant  INTEGER  :=  M2'FIRST(1)  -  M1'FIRST(2); 

beg  in 

if  Ml ' LENGTH (2)  /=  M2' LENGTH (1)  then 
raise  SIZE_ERROR; 
end  if; 

for  I  in  Ml'FIRST(l)  ..  Ml'LAST(l)  loop 
for  J  in  M2 'FIRST (2)  ..  M2'LAST(2)  loop 
TEMP( I , J)  :«  0.0; 

for  K  in  M1'FIRST(2)  ..  M1'LAST(2)  loop 

TEMP ( I , J )  :»  TEMP { I , J)  +  M1(I,K)  *  M2(K  +  OFFSET,  J) ; 
end  loop; 
end  loop; 
end  loop; 

return  TEMP; 

end  ; 

end  MATRIX  OPS; 


Exceptions  Raised  by  Packages 


package  MATRIX_OPS  is 

type  MATRIX  is  array  (  INTEGER  range  <>,  INTEGER  <>  )  of  FLOAT 
SIZE_ERROR  :  exception; 

function  "+"  (  A  s  FLOAT;  M  :  MATRIX  )  return  MATRIX; 

function  "+"  (  Ml,  M2  :  MATRIX  )  return  MATRIX; 

—  may  raise  exception  SIZE_ERROR  if  Ml  and  M2 

—  are  not  the  same  size 

function  (  A  :  FLOAT;  M  :  MATRIX  )  return  MATRIX; 

function  (  Ml,  M2  :  MATRIX  )  return  MATRIX; 

—  may  raise  exception  SIZE_ERROR  if  the  number 

—  of  columns  of  Ml  is  not  equal  to  the  number 

—  of  rows  of  M2 

end  MATRIX  OPS; 


USER  DEFINED  EXCEPTIONS 


Exception  declaration 

identif ier_list  :  exception; 
SIZE  ERROR  :  exception; 


Raise  statement 

raise  except ion_name; 
raise  SIZE  ERROR; 


Example 


package  MATRIX  OPS  is 


SIZE  ERROR  :  exception; 


end  MATRIX_OPS; 

package  body  MATRIX_OPS  is 


function  (  Ml, M2  s  MATRIX  ) 

return  MATRIX  is 


begin 

if  Ml 'LENGTH (2)  /=  M2' LENGTH (1)  then 
raise  SIZE_ERROR; 
end  if; 

•  •  • 

end 


end  MATRIX  OPS; 


Handling  Exceptions 


declare 

use  MATRIXJDPS; 

A,B  :  MATRIX  {  1 . . 1 0, 1 . . 20 ) ; 


beg  in 


C  :*  A  *  B;  —  causes  SIZE_ERROR 

E  1  *  .  «  »  r 

end; 


This  block  does  not  have  local 
handler.  Should  SIZE_ERROR  be 
raised,  it  will  be  propogated 
to  enclosing  unit. 


Handling  Exceptions 


When  exception  is  raised  and 
propogated  to  unit  with  local 
handler  execution  of  handler 
replaces  execution  of  remainder 
of  unit. 


Handler  "acts”  as  substitute  for 
corresponding  unit. 

.  handler  has  access  to 
parameters  ' 

.  handler  can  issue  a 
return 


If  no  handler  exists  for  exception, 
program  will  terminate! 


Handling  Exceptions 


procedure  P  is 

ERROR  :  exception; 

•  •  • 
beg  in 
•  •  • 

raise  ERROR;  —  This  exception  is  handled 

—  by  El 


exception 

when  ERROR  => 

•  •  • 

end  P  ; 


handler  El 
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Handling  Exceptions 


procedure  P  is 
*  •  • 

ERROR  :  exception; 

•  •  • 

procedure  Q  is 
beg  in 

*  •  •  , 
raise  ERROR; 

—  This  exception  is  handled  by  E2. 

•  •  e 

exception 


when  ERROR  =>...;  —  handler  E2 

—  After  execution  of  the  handler,  Q  returns 

—  normally,  unless  the  handler  executes  a 

—  raise  statement. 

—  Execution  of  "raise;*  would  propogate 
—  ERROR  out  to  P,  where  it  would  be  handled  by  El. 

end  Q; 


beg  in 


Q; 


exception 
•  •  • 


when  ERROR  =>  . ..;  —  handler  El 


end  P; 
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Handling  Exceptions 


procedure  P  is 


ERROR  :  exception; 


procedure  R  is 
beg  in 
•  •  • 

raise  ERROR; 

—  Since  there  are  no  handlers  in  R,  its  execution 

—  will  be  terminated  and  the  exception  will  be 

—  propogated  to  the  calling  subprogram. 


end  R; 


procedure  Q  is 
beg  in 
•  •  • 

R;  —  An  ERROR  exception  raised  by  this  call  to 
—  R  is  handled  by  handler  E2. 

•  •  • 

exception 
•  •  • 

when  ERROR  *>...;  —  handler  E2 

end  Q; 


beg  in 
•  •  • 

Q? 

•  •  • 

R;  —  An  ERROR  exception  raised  by  this  call  to 
—  R  is  handled  by  handler  El. 

•  •  • 

exception 
•  •  • 

when  ERROR  =>...;  —  handler  El 

end  P; 
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Exceptions  in  Example  III 


procedure  GET_VALID  RECORD  (REC  :  out  ITEM_RECORD; 

END_OF  DATA  :  out  BOOLEAN)  is 

S  :  RECORD_STRING; 

LENGTH_ERROR  :  BOOLEAN; 
begin 
loop 

GET  NEXT_RECORD  (S  ,  LENGTH_ERROR) ; 
if  LENGTH  ERROR  or  else  not  VALID  RECORD  then 
WRITEjSRROR  (S) ; 
else 

REC  :=  CONVERT  (S)  ; 
exit; 
end  if; 
end  loop; 

—  exit  from  loop  only  occurs  when  good  record  found 

—  or  when  an  END_ERROR  exception  occurs  in 
—  GET_NEXT_RECORD 

END  OF_DATA  :=  FALSE; 
exception 

when  END  ERROR  =>  END  OF_DATA  TRUE; 
end  GET  VALID  RECORD; 


GET_VA LI D_R EC ORD  calls  GET_NEXT_RECORD 
GET_NEXT_RECORD  calls  GET 

GET  is  a  procedure  defined  in  the  standard  package  TEXT_IO  and 
END_ERROR  is  an  exception  defined  in  that  package  which  can 
result  from  a  call  to  GET. 


Since  there  is  no  handler  in  GET_NEXT_RECORD,  that  procedure 
terminates  and  the  exception  is  propogated  on  to 
GET_VALID_RECORD,  where  it  is  "handled"  by  the  exception  handler 
shown  above. 

NOTE  :  A  normal  return  from  GET  VALID  RECORD  follows. 
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Exceptions  in  Example  III 


Suppose  we  want  to  terminate  the  loop  in  PROCESS_RECORDS  using  an 
exception  when  no  more  records  are  available.  The  following 
redefinition  of  RECORD_HANDLER  would  be  appropriate. 


package  RECORD_HANDLER  is 

type  ITEM_RECORD  is 
record 

ITEM_CODE  :  record 

PREFIX  :  STRING (1. .2) ; 

NUMBER  :  range  0..9999; 

SUFFIX  :  CHARACTER; 
end; 

DESCRIPTION  :  STRING ( 1 .. 30) ; 

QUANTITY  s  range  0.. 999999; 
end  ITEM_RECORD 

procedure  OPEN_FILES; 

procedure  CLOSE_FILES; 

procedure  GET_VALID_RECORO  (REC  ;  out  ITEM_RECORD) ; 

NO_MORE_RECORDS  :  exception; 

~ —  This  exception  is  raised  by  GET  VALID_RECORD 
—  when  the  end  of  the  input  file  7s  encountered. 

procedure  WRITE_RECORD  (REC  ;  in  ITEM_RECORD) ; 

end  RECORD  HANDLER; 
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Exceptions  in  Example  III 


PROCESS_RECORDS  could  depend  on  the  exception 
NO  MORE  RECORDS: 


with  RECORD_HANDLER; 
procedure  PROCESS_RECORDS  is 
use  RECORD_HANDLER ; 

ITEM  :  ITEM_RECORD;  —  defined  in  RECORD_HANDLER 
begin 

OPEN_F ILES ; 
loop 

GET_VALID_RECORD  ( ITEM , NO_MORE  RECORDS); 

WRITE_RECORD  (ITEM); 
end  loop; 
exception 

when  NO_MORE_RECORDS  =>  CLOSE_FILES; 
end  PROCESS  RECORDS; 


Exceptions  in  Example  III 


The  body  of  GET  VALID_RECORD  changes  slightly. 


procedure  GET_VALID_RECORD  (REC  :  out  ITEM_RECORD)  is 
S  :  RECORD  STRING; 

LENGTH_ERR()R  :  BOOLEAN; 
beg  in 
loop 

GET_NEXT_RECORD  (S  ,  LENGTH_ERROR) ; 
if  LENGTH_ERROR  or  else  not  VALID  RECORD  then 
WRITE_ERROR  (S) ; 
else 

REC  :=  CONVERT  (S)  ; 
exit ; 
end  if; 
end  loop; 

—  exit  from  loop  only  occurs  when  good  record  found 

—  or  when  an  END  ERROR  exception  occurs  in 
—  GET_NEXT_REC0R1B 

exception 

when  END  ERROR  =>  raise  NO  MORE  RECORDS; 
end  GET  VALID  RECORD;  ~ 


The  END_ERROR  exception  is  handled,  as  before, 
but  the  handler  raises  the  new  NO_MORE_RECORDS 
exception  defined  in  the  specification  part  of 
this  package. 
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SUMMARY 


Overloading 


Exceptions 


ckages  and  Exceptions 
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EXAMPLE  VI 


LIST  PROCESSING 


OBJECTIVES 


Access  Types 


Data  Abstraction 


Generics 


Discriminants 


Variant  Records 


VI 


List  Processing 


—  The  following  is  an  example  of  a  list  processing  package, 

—  making  use  of  access  types  for  dynamic  allocation  of  list  nodes. 

package  SORTED_LIST  is 
•  type  LIST  is  private; 

type  PRIORITYJTYPE  is  new  NATURAL;  —  derived  type 

procedure  CREATE  (HEADER  :  out  LIST) ; 

procedure  INSERT  (HEADER  :  in  out  LIST; 

INFO  s  INFO  TYPE; 

PRIORITY  :  ?RIORITY_TYPE) ; 

procedure  NEXT  ENTRY  (HEADER  :  in  out  LIST; 

INFO  :  out  INFO_TYP£; 

PRIORITY  :  out  PRIORITY_TYPE) ; 

EM PT Y_L I ST  s  exception;  —  can  be  raised  by  NEXT_ENTRY 

private 

type  NODE;  —  incomplete  type  declaration 
type  LIST  is  access  NODE; 
type  NODE  is 
record 

PREVIOUS  s  LIST; 

PRIORITY  :  PRIORITY  TYPE; 

INFO  :  access  INFO  TYPE; 

NEXT  s  LIST; 
end; 

end  SORTED  LIST 


—  The  procedures  in  this  package  maintain  a  list 

—  of  items,  sorted  by  priority  (increasing).  The  procedure 

—  CREATE  must  be  called  each  time  a  new  list 

—  is  desired.  During  the  execution  of  a  program 

—  any  number  of  lists  may  exist.  A  call  to  NEXT_ENTRY 

—  returns  the  info  and  priority  for  the  first  item 

—  and  removes  this  entry  from  the  list. 
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package  body  SORTED__LIST  is 


procedure  CREATE  (HEADER  :  out  LIST)  is 
begin  —  Build  a  dummy  node  to  represent  an  empty  list 
HEADER  s«  new  NODE  (PRIORITY  ■>  lf  INFO  *>  null, 

PREVIOUS  ->  null,  NEXT  ■>  null); 
HEADER. PREVIOUS  :>  HEADER;  HEADER. NEXT  :■  HEADER; 
end  CREATE ; 


procedure  INSERT  (HEADER  :  in  out  LIST; 

INFO  s  INFO  TYPE; 

priority  s  Priority  type)  is 

PTR  :  LIST; 
beg  in 

PTR  s«  HEADER. NEXT; 
while  PTR  /•  HEADER  and 

PRIORITY  <«  PTR. PRIORITY  loop 
PTR  :«  PTR. NEXT; 
end  loop;  * 

— PTR  now  references  the  record  which  will  follow 
— the  new  record  in  the  list. 

PTR. PREVIOUS. NEXT  :■  new  NODE  (PTR. PREVIOUS,  PRIORITY, 

new  INFO_TYPE (INFO) ,  PTR); 
PTR. PREVIOUS  PTR. PREVIOUS. NEXT; 
end  INSERT; 


procedure  NEXT_ENTRY  (HEADER  :  in  out  LIST; 

INFO  •  out  INFO_TYPE; 

PRIORITY  :  out  PRIORITY_TYPE)  is 
FIRST  J  LIST  :=  HEADER. NEXT; 
beg  in 

if  FIRST  «  HEADER  then 
raise  EM PTY_LIST; 
end  if; 

PRIORITY  :»  FIRST. PRIORITY; 

INFO  :*  FIRST. INFO. all; 

FIRST  :«  FIRST. NEXT; 

HEADER. NEXT  J«  FIRST; 

FIRST. PREVIOUS  HEADER; 
end  NEXT  ENTRY; 


end  SORTED  LIST; 
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INTRODUCTION  TO  ACCESS  TYPES 

(  LINKED  LISTS  ) 


type  NODE;  —  incomplete  type  declaration; 

type  NODE_PTR  is  access  NODE; 

type  NODE  is 
record 

WORD  j  STRING  ( 1.  .3)  ; 

NEXT  s  NODE_PTR; 
end  record; 


Object  declaration: 

FIRST,  LAST  :  NODE  PTR; 
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FIRST  :■  new  NODE  ("ALL"  ,nul  1 ) ; 


FIRST. WORD  «  "ALL" 
FIRST. NEXT  «  null 


FIRST. NEXT  :*  new  NODE 
(  WORD  *=>  "BUT"  , 
NEXT  «>  null  )  ; 


FIRST. NEXT.WORD  -  -BUT" 
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i-AST 


:=  LAST; 


FIRST. NEXT. NEXT 


To  print  the  WORD  fields  of  the  records  (  assume  zero  or 
more  nodes  ) : 


declare 

T  :  NODEJPTR  :■  FIRST; 
begin 

while  T  /*  null  loop 
PUT  (  T.WORD  ) ; 
NEW_LINE; 

T  :«  T.NEXT; 
end  loop; 
end; 


VI. 170 


DOUBLY  LINKED  LIST 

r 


HEADER 

Maintain  a  list  of  items  sorted  by  priority  (decreasing) 


PROCEDURES: 
CREATE 
INSERT 
NEXT  ENTRY 
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i  r  i  i 

|  PREVIOUS  I  PRIORITY  I  INFO  I  NEXT 

I _ I _ I - 1 - 

type  INFO_TYPE  is  ...  ; 
type  PRIORITY_TYP£  is  ...  ; 

type  NODE; 

type  LIST  is  access  NODE; 

type  NODE  is 
record 

PREVIOUS  :  LIST; 

PRIORITY  J  PRIORITYJTYPE; 

INFO  :  access  INFOJTYPE; 

NEXT  :  LIST; 

end  record; 

type  LIST  is  access  NODE; 


PRIVATE  TYPE 


package  SORTED_LIST  is 
type  LIST  is  private; 

procedure  CREATE  (...);  visible 

procedure  INSERT  (...);  part 

proced  ure  NEXT_ENTRY  (...); 

EMPTY_LIST  s  exception; 
private 

type  NODE; 

type  LIST  is  access  NODE; 
type  NODE  is 

record  private 

...  part 

end  record; 

end  SORTED  LIST; 


Name  of  type  and  operations  specified  in  visible  part 
available . 


Names  of  fields  are  not  visible. 


are 
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i. 


procedure  CREATE 

(  HEADER  :  out  LIST  )  is 
begin 

HEADER  s ■  new  LIST 

(  PRIORITY  ->  1  , 

INFO  *>  null , 
PREVIOUS  =>  null, 
NEXT  *>  null  ); 
HEADER. PREVIOUS  :  =  HEADER; 
HEADER. NEXT  :=  HEADER; 
end  CREATE; 


<t> 


HEADER 


1 


Procedure  — ^  ajse&t- 
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procedure  INSERT  (HEADER  :  in  out  LIST; 

INFO  :  INFO  TYPE; 

PRIORITY  :  ?RIORITY  TYPE)  is 


PTR  s  LIST; 
begin 

PTR  :*  HEADER. NEXT; 

while  PTR  /«  HEADER  and 

PRIORITY  <=  PTR. PRIORITY  loop 
PTR  s*  PTR. NEXT; 
end  loop; 


— PTR  now  references  the  record  which  will  follow 
— the  new  record  in  the  list. 

PTR. PREVIOUS. NEXT  :*  new  NODE  (PTR. PREVIOUS,  PRIORITY, 

new  INFO_TYPE (INFO)  ,  PTR); 

PTR. PREVIOUS  :«  PTR. PREVIOUS. NEXT; 

end  INSERT; 


j 

f 


1 


\ 
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procedure  INSERT  ( 
beg  in 


)  is 


PTR  :*  HEADER. NEXT; 

while  PTR  /«  HEADER  and 

PRIORITY  <*  PTR. PRIORITY  loop 

PTR  !«  PTR. NEXT; 

end  loop; 


upon  exit  from  loop: 


PTR. 


LIST 


(  PTR. PREVIOUS, 
PRIORITY, 

new  INF 0_TYPE( INFO)  , 
PTR  ) 


PTR 


•  •  • 


s 


3 


PTR. PREVIOUS. NEXT  new  LIST(...)f 


PTR 


PTR. PREVIOUS  :=  PTR. PREVIOUS . NEXT ; 


PTR 


INSEPT  at  end  of  list 


PTR 


PTR  /«  HEADER  is  true 
PRIORITY  <*  PTR. PRIORITY  is  true 


PTR 


PTR  /«  HEADER  is  false 


loop  terminates 


PTR 

PTR. PREVIOUS. NEXT  J«  new  LIST (...)} 


PTR 


PTR. PREVIOUS  :■  PTR. PREVIOUS. NEXT; 


i: 

i 


INSERT  first  item 


loop  terminates  immediately  with 
PTR  *  HEADER 


pTft 


PTR.  PREVIOUS. NEXT  :»  new  LIST  (...); 


PTR. PREVIOUS  ;«  PTR. PREVIOUS. NEXT; 


VjTft] 


V 


- ..  JCEDURE  next  entry 


1 


PRIORITY  :=  FIRST.  PRIORITY  ,*  —  •  8 

INFO  :«  FIRST. INFO. all; 
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/ 


FIRST 

FIRST  :■  FIRST. NEXT; 


FIRST. PREVIOUS  :■  HEADER; 


FIRST 


PXRST 


FIRST. PREVIOUS  HEADER; 


—  The  following  is  an  example  of  how  SORTED_LIST  might  be  used. 

—  The  package  is  declared  inside  of  this  procedure  so  that  use 

—  may  be  made  of  a  local  definition  of  INFO__TYPE. 

procedure  PRINT_HANDLER; 

type  INFOJTYPE  is 
record"” 

•  •  • 

end  record; 


package  SORTED_LIST  is 

—  specification  part  as  defined  previously, 

—  using  INFO  TYPE  as  just  declared 
end  SORTED  LIST;- 


use  SORTED_LIST; 

PRINT_QUEUE  :  LIST; 
PRIORITY  :  PRIORITY  TYPE; 
DESCRIPTOR  s  INFO  T?PE ; 


package  body  SORTED_LIST  is 
—  as  defined  previously 
end  SORTED  LIST; 


begin  —  body  of  PR INT_HANDLER : 
CREATE  (PRINT  QUEUE); 


—  assume  some  value  has  been  given  to  DESCRIPTOR 
INSERT  (PRINT  QUEUE,  DESCRIPTOR,  2); 


NEXT  ENTRY  (PRINT  QUEUE,  DESCRIPTOR,  PRIORITY); 


end  PRINT  HANDLER; 
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Example  VI 
Version  2 

Introduction  to  Generics 


—  A  more  general  list  processing  package  definition  is  now 

—  presented,  making  use  of  the  generic  definition  feature. 

—  Since  the  package  does  not  depend  on  the  details  of  INFOJTYPE, 

—  it  is  now  supplied  as  a  generic  parameter  of  the  packageT 

generic 

type  INFO_TYPE  is  private; 
package  SORTED__LIST  is 
type  LIST  is  private; 

type  PRIORITYJTYPE  is  new  NATURAL;  —  derived  type 

procedure  CREATE  (HEADER  :  out  LIST); 

procedure  INSERT  (HEADER  :  in  out  LIST; 

INFO  s  INFO  TYPE; 

PRIORITY  s  PRIORITYJTYPE) ; 

procedure  NEXT_ENTRY  (HEADER  :  in  out  LIST; 

INFO  :  out  INFO  TYPE; 

PRIORITY  s  out  PRIORITYJTYPE) ; 

EMPTY_LIST  :  exception;  —  can  be  raised  by  NEXT_ENTRY 

private 

type  NODE; 

type  LIST  is  access  NODE; 
type  NODE  is 
record 

PREVIOUS  :  LIST; 

PRIORITY  :  PRIORITY  TYPE; 

INFO  :  access  INFO  TYPE; 

NEXT  :  LIST; 
end  record; 

end  SORTED  LIST 
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~  The  procedures  in  this  package  maintain  a  list 

—  of  items,  sorted  by  priority  (increasing)  .  'Hie  procedure 

—  CREATE  must  be  called  each  time  a  new  list 

— ■  is  desired.  During  the  execution  of  a  program 

—  any  number  of  lists  may  exist.  A  call  to  NEXT_ENTRY 

—  returns  the  info  and  priority  for  the  first  item 

—  and  removes  this  entry  from  the  list. 

package  body  SORTED_LIST  is 

procedure  CREATE  (HEADER  :  out  LIST)  is 
begin  —  Build  a  dummy  node  to  represent  an  empty  list 
HEADER  :■  new  NODE  (PRIORITY  «>  1,  INFO  *>  null, 

PREVIOUS  ■  >  null,  NEXT  «>  null) 
HEADER. PREVIOUS  :*  HEADER;  HEADER. NEXT  :«  HEADER; 
end  CREATE; 


procedure  INSERT  (HEADER  :  in  out  LIST; 

INFO  :  INFO  TYPE; 

PRIORITY  :  PRIORITY  TYPE)  is 

PTR  :  LIST; 
beg  in 

PTR  :«  HEADER. NEXT 
while  PTR  /=  HEADER  and 

PRIORITY  <=  PTR. PRIORITY  loop 
PTR  :=  PTR. NEXT; 
end  loop; 

— PTR  now  references  the  record  which  will  follow 
— the  new  record  in  the  list. 

PTR. PREVIOUS. NEXT  :»  new  NODE  (PTR. PREVIOUS ,  PRIORITY, 

new  INFO_TYPE (INFO) ,  PTR) 
PTR. PREVIOUS  :=  PTR. PREVIOUS. NEXT; 
end  INSERT; 


procedure  NEXT_ENTRY  (HEADER  :  in  out  LIST; 

INFO  :  out  INFO_TYPE ; 

PRIORITY  :  out  PRIORITY  TYPE)  is 
FIRST  :  LIST  :=  HEADER. NEXT; 
beg  in 

if  FIRST  «  HEADER  then 
raise  EMPTY_LIST; 
end  if; 

PRIORITY  s«  FIRST. PRIORITY; 

INFO  :«  FIRST. INFO. all; 

FIRST  :■  FIRST. NEXT; 

HEADER. NEXT  :*  FIRST; 

FIRST. PREVIOUS  :*  HEADER; 
end  NEXT_ENTRY; 

end  SORTED  LIST; 


GENERIC  PROGRAM  UNITS 


"Models"  of  program  units. 


Can  be  parameterized: 


Generic  instantiation  creates  a  copy  (instance)  of  a 
generic  prooram  unit  which  can  be  used  directly  as 
ordinary  program  units. 


A  generic  subprogram: 
generic 

type  ELEMENT  is  private; 
procedure  EXCHANGE  (X,Y  :  in  out  ELEMENT)  is 
TEMP  :  constant  ELEMENT  :■  X; 
beg  in 

X  :*  Y; 

Y  :*  TEMP; 
end  SWAP; 


Declarations  with  generic  instantiation: 

procedure  SWAP_INT  is  new  EXCHANGE  (INTEGER); 

procedure  SWAP  CHAR  is  new  EXCHANGE  (ELEMENT  =>  CHARACTER); 


Overloading  a  procedure  name: 


procedure  SWAP  is  new  EXCHANGE  (INTEGER); 
procedure  SWAP  is  new  EXCHANGE  (CHARACTER); 


VI. 340 


—  The  package  SORTED  LIST  may  now  be  treated  as  a  library  package, 

—  with  a  particular  lype  being  supplied  for  INFO  TYPE  when  an 

—  instance  of  the  generic  package  is  created.  Pl?INT_HANDLER 

—  is  now  reconsidered  using  this  new  approach. 

with  SORTED_LIST; 

procedure  PRlNTJiANDLER  is 

type  PRINTJDESCRIPTOR  is 
record  — 

e  e  • 

end; 


package  PRINT  LIST  is 

new  SORTED~LIST  {INFO  TYPE  «>  PRINT  DESCRIPTOR); 


use  PRINT_LIST; 

PRINT_QUEUE  :  LIST; 

PRIORITY  :  PRIORITY  TYPE; 
DESCRIPTOR  ;  PRINT_DESCRIPTOR ; 

begin  —  body  of  PRINT_HANDLER: 

CREATE  (PRINT  QUEUE) ; 


—  assume  some  value  has  been  given  to  DESCRIPTOR 
INSERT  (PRINT  QUEUE,  DESCRIPTOR,  2); 


NEXT  ENTRY  (PRINT  QUEUE,  DESCRIPTOR,  PRIORITY); 


end  PRINT  HANDLER; 
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Definition  of  generic  package: 


generic 

type  INFO  TYPE  is  private; 
package  SORTlD^LIST  is 


end  SORTED  LIST 


Instantiation  of  generic  package: 


with  SORTED_LIST; 
procedure  PRINT_DESCRIPTOR  is 
type  PRINT  DESCRIPTOR  is 
record  ~ 

•  %  • 

end  record; 
package  PRINT  LIST  is 

new  SORTEDJLIST  (INFO_TYPE  *>  PRINT_DESCRIPTOR) ; 


end  PRINT  DESCRIPTOR; 
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GENERIC  INSTANTIATION 


The  instantiation  "brings  into  existence"  the  procedures 
PRINT_LIST. CREATE  (  ...  ); 

PRINT_LIST. INSERT  {  ...  ); 
and 

PRINT  LIST. NEXT  ENTRY  (  ...  )} 


which  perform  operations  on  a  doubly  linked  list  in 
which  one  component  of  each  node  is  a  pointer  (access  type) 
to  a  record  to  type  PRINT  DESCRIPTOR. 


—  Instantiation 

package  L  is 

new  SORTED  LIST  (T) 


Procedure  call 
L. INSERT (  ...  ) 


will  insert  a  record  into  the  list  in  which  one  component 
is  a  pointer  to  an  object  of  type  T 


OTHER  GENERIC  PARAMETER  FORMS 


type  identifier  is  (<>);  —  denotes  any  discrete  type 


generic 

•  type  T  is  (<>) ; 
function  NEXT  IN  CYCLE  (X 
begin 

if  X  »  T ' LAST  then 
return  T'FIRST 
else 

return  T'SUCC(X) 
end  i f ; 

end  NEXT  IN  CYCLE; 


T)  return  T  is 


type  DIRECTION  is  (NORTH, EAST, SOUTH, WEST) ; 
type  WEEKDAY  is  (MON,  TUBS,  WED,  THUR,  FRI ) ; 

function  TURNJUGHT  is  new  NEXT_IN_CYCLE  (DIRECTION); 
function  NEXT_WEEKDAY  is  new  NE XT_IN_C YC LE  (WEEKDAY) ; 

TURN_RIGHT(  EAST  )  ■  SOUTH 
TURN  RIGHT (  WEST  )  -  NORTH 


NEXT_WEEKDAY(  TUES  )  «  WED 
NEXT  WEEKDAY (  FRI  )  -  MON 


DISCRIMINANTS 


Provides  a  form  of  "dynamic"  parameterization;  value  of 
discriminant  need  not  be  known  at  translation  time. 


Object  of  record__type  with  discriminant  may  be  a 
constrained  object  or  an  unconstrained  object  (dynamic 
allocation)  . 


Discriminant  may  be  used 

(a)  as  a  bound  of  an  index  constraint 

(b)  to  specify  a  discriminant  value 
in  a  discriminant  specification 

(c)  as  a  discriminant  name  of  a  variant 
part 


Discriminant  must  be  a  discrete  type 


DISCRIMINANTS 


Example : 

MAX_MESSAGE_SIZE  :  NATURAL  :«  1000; 

type  BUFFER  TYPE  (  SIZE  :  INTEGER  range 

O..MAX_Mt5SJreE  SIZE)  Is 
record  “ 

ADDRESS  :  .  .  .  ; 

MESSAGE  :  STRING  (  1..SIZE); 
end  record; 


Constrained  Object 
IN  BUFF  :  BUFFER  TYPE(500); 


500 


IN_BUFF . SIZE  IN_BUFF. ADDRESS  IN_BUFF .MESSAGE ( 1 .. 500) 


OUT_BUFF  ;  BUFFER_TYPE (  SIZE  ■>  25  ); 

l - 1 - 1 - T 

I  25  |  I  I 

I _ I _ I _ I 

OUT  BUFF. SIZE  OUT  BUFF. ADDRESS  OUT  BUFF. MESSAGE (1 .. 25) 
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Unconstrained  Object 


declare 
•  •  • 

A_BUFFER  s  BUFFER_TYPE;  —  discriminant  omitted 
DESTINATION:  .  . 

FULL  LINE  :  STRING  (1 .  .MAX__MESSAGE_SIZE)  ; 

ACTUAL_LENGTH  :  NATURAL  0; 
beg  in 

GET_MESSAGE(  DESTINATION,  FULL_LINE,  ACTUAL_LENGTH) ; 

A  BUFFER  :«  (ACTUAL  LENGTH,  DESTINATION, 

“  full_lYne(1. . ACTUAL_LENGTH)  )  ; 

•  •  • 

end; 

If  GET_MESSAGE  returns  a  value  of  475  as  the  value  of  ACTUAL_LENGTH, 
the  effect  of  the  assignment  statement  is  to  create  the  record 

1  i  I  T 

I  475  I  value  of  I  value  of  FULL  LINE(1..475)  I 
I  I  DESTINATION  |  “  | 
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VARIANT  RECORDS 


A  list  of  records,  each  of  which  have  certain  objects  in 
common.  The  remaining  components  depend  on  the  value  of 
some  other  component  which  is  called  the  "discriminant”. 


VARIANT  PART 


Variant  part  specifies  alternative  record  components.  Each 
variant  defines  the  components  which  exist  for  a  specific 
value  of  the  discriminant. 


DISCRIMINANT: 

Special  component  of  records. 
Discriminant  must  be  a  discrete  type. 


Provides  a  form  of  "dynamic"  parameterization;  value 
of  discriminant  need  not  be  known  at  translation  time. 


RECTANGLE 


2.5 


5.0 


discriminant 


fixed  part 


variant  part 


LINE 


4.8 
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type  record_type  (discriminant  :  discr iminant_type)  is 
record 

—  object  declaration(s) 

—  fixed  part 
(optional) 


case  discriminant  is 

when  choice  •>  component_list ; 
•  •  • 

when  choice  «>  component_list; 
end  case ; 
end  record; 


Each  value  of  the  discriminant  must  be  represented  once  and 
only  once  in  the  set  of  choices. 


type  COORDINATES  is 
record 

X,  Y  :  FLOAT; 
end  record; 

type  DEGREES  is  new  FLOAT; 

—  derived  type;  differentiate  from 

—  length  measurements 


type  SHAPEJTYPE  is  (SQUARE,  RECTANGLE,  LINE,  ARC,  CIRCLE) 

type  FIGURE  (SHAPE  :  SHAPEJTYPE)  is 
record 

COLOR  :  (RED,  GREEN,  BLUE); 

LINE_STYLE  s  (SOLID_LINE,  DOTTED_LINE) ; 

POSITION  :  COORDINATES; 

ANGLE  :  DEGREES; 

case  SHAPE  is 


when 

SQUARE 

=> 

SIZE 

• 

• 

FLOAT; 

when 

RECTANGLE 

=  > 

HEIGHT,  WIDTH 

• 

• 

FLOAT; 

when 

LINE 

=> 

LENGTH 

• 

• 

FLOAT; 

when 

ARC 

=  > 

RADIUS 

• 

• 

FLOAT; 

ARC_LENGTH 

• 

• 

DEGREES 

when 

CIRCLE 

«> 

DIAMETER 

• 

• 

FLOAT; 

end  case; 
end  record; 


I 

I 


RECORD  AGGREGATES 

Using  positional  notation: 

(RECTANGLE,  RED,  SOLID_LINE,  (1.5,  3.4), 
'  discriminant  must  appear  first 


Using  named  components 


(COLOR  «>  RED,  LINE_ 

STYLE 

POSITION  ->  (1.5, 

3.4)  , 

ANGLE  «>  45.0, 

SHAPE 

HEIGHT  «>  2.5, 

WIDTH 

45.0,  2.5,  5.0) 


i: 

i: 

[ 
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An  Application 


type  ITEM; 


type  POINTER  is  access  ITEM; 


type  ITEM  is 
record 

NEXT_I TEM  :  POINTER; 
COMPONENT  :  FIGURE; 
end  record; 


PICTURE  :  POINTER; 

PICTURE  :*  new  ITEM  (  null,  (  RECTANGLE,  ...  ,  2.5,  5.0  )  ); 
PICTURE. NEXT  ITEM  :*  new  ITEM  (  null,  (  LINE,  ...  ,  4.8  )  ); 


T 

I 


PICTURE 


> 


RECTANGLE 


2.5 


5.0 


> 


null 


LINE 


4.8 


PICTURE. COMPONENT. SHAPE  -  RECTANGLE 


reference 


PICTURE. COMPONENT. HEIGHT  j-  3.5; 


assignment 


PICTURE. COMPONENT. DIAMETER  —  illegal  reference 

PICTURE. COMPONENT. SHAPE  :«  CIRCLE  —  illegal  assignment 
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SUMMARY 


Access  Types 
Data  Abstraction 

Generics 

Discriminants 


Variant  Records 


m 


EXAMPLE  VII 


Fundamentals  of  Tasking 


VII. 100 


OBJECTIVES 


Task  Concepts 


A  Fault  Warning  Procedure 


procedure  ANN OUNCE_F AULT  ( FAULT_CODE  :  INTEGER)  is 

task  RING_WARNING_BELL; 

task  FLASH_RED_LIGHT; 

task  PRINT_MESSAGE; 

task  body  RING_WARNING_BELL  is 
•  •  • 

end  RING_WARNING  BELL; 

task  body  FLASH_RED_LIGHT  is 
•  •  • 

end  FLASH_RED_LIGHT; 

task  body  PRINT_MESSAGE  is 
•  •  • 

end  PRINT  MESSAGE; 


begin  —  body  of  procedure 

—  wait  for  tasks  to  do  their  work 

—  order  of  execution  is  unimportant 

end  ANNOUNCE  FAULT; 
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function  SUM_ARRAYS  ( A, B  :  FLOAT_ARRAY) 
return  FLOAT 


I 

<  > 


t - r 

I  SUM  A| 


>  < 
I 
I 


I 

I 

i - r 

I  SUM  B  | 

I  “  t 
I 
I 


I  return  I 

I  SUM  OF  A  +  SUM  OF  B  | 


SUM_OF_A  «  A( A'FIRST)  +  ...+  A{A' LAST) 

SUM_OF_B  -  B(B' FIRST)  +  ...+  B ( B* LAST) 

Tasks  SUM_A  and  SUM__B  can  be  processed  in  parallel. 
They  are  independent  processes. 

Each  involves  simple  sequential  processes. 

No  inter-process  communication  and  no  sharing  of  data. 
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function  SUM_ARRAYS  (A,  B  s  FLOAT_ARRAY)  return  FLOAT  is 

—  This  is  an  example  of  tasks  which  can  run  in  parallel 

—  because  they  do  not  interact. 

SUM_OF_A,  SUM  OF_B  :  FLOAT  :«  0.0; 

begin 

declare  —  a  block  to  contain  the  tasks 

task  SUM_A;  —  simplest  possible  task  declaration 
task  SUM_B;  —  another,  to  run  in  parallel 


task  body  SUM_A  is  —  corresponds  to  a  package  body 
beg  in 

for  I  in  A’FIRST  ..  A* LAST  loop 
SUM_0F_A  :=  SUM_0F_A  +  A(I) ; 
end  loop;- 
end  SUM  A; 


task  body  SUM_B  is 
begin 

for  I  in  B'FIRST  ..  B' LAST  loop 
SUM_OF_B  :=  SUM_OF_B  +  B(I); 
end  loop;-  ~  — 

end  SUM  B; 


begin  —  body  of  block 
null ; 

—  This  block  will  not  terminate  until  both  tasks  terminate 
—  because  they  are  declared  in  the  block, 
end; 

return  SUM_0F  A  +  SUM_0F_B; 
end  SUM_ARRAYS;  “ 

—  This  example  can  be  generalized  to  involve  any  number  of  arrays 

—  and  tasks,  with  one  task  being  declared  for  each  array. 
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function  SUM  ARRAYS  ( A,B  :  FLOAT_ARRAY) 
return  FLOAT  is 

SUM_OF_A,  SUM_OF_B  s  FLOAT  s*  0.0; 
begin 

declare 

...  —  task  declarations 
...  —  task  bodies 
beg  in 

—  empty  body  (of  block) 

end 

return  SUM_OF_A  +  SUM_0F_B ; 
end  SUM_ARRAYS ; 

Elaboration  of  the  task  bodies  causes  their  initiation. 

Only  when  tasks  declared  within  block  terminate  will  the 
block  terminate. 
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Task  Specification 


task  [ type]  identifier 

is  entry  -  declaration  \ 
entry  -  declaration  | 

I 

...  \  optional 

/ 

entry  declaration  | 

I 

end  identifier  / 

A  single  task  can  be  declared  by  a  task  specification,  as 
has  been  done  in  this  example, 

or 

A  task  type  can  be  declared,  allowing  any  number  of 
variables  or  that  type  to  be  created. 

Task  types  allow  the  inclusion  of  tasks  in  any  data  struc¬ 
ture  and  dynamic  creation  of  tasks  using  access  types  which 
reference  tasks. 


Example  of  Task  Types 


task  type  RESOURCE  is 
entry  SEIZE; 
entry  RELEASE; 
end  RESOURCE; 


SINGLE  :  RESOURCE; 

POOL  :  array  (1..10)  of  RESOURCE. 


SINGLE. SEIZE 
POOL (K) .RELEASE 
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OBJECTIVES 


Entries 

Accept  Statements 
Rendezvous 

Task  Attributes 

Select  Statements 


vm.no 


Example  VIII 
Version  1 
Task  Interactions 


—  An  example  of  cooperating  tasks  running  in  parallel. 


BLOCK  LENGTH  :  constant  INTEGER  :=  100; 

type  1L0CK  is  array  (1.. BLOCK  LENGTH)  of  INTEGER; 


task  PRODUCE_B LOCK ; 

—  A  task  which  produces  blocks  of  data  items  from  any  source. 

—  Each  block  is  BLOCK  LENGTH  data  items  long. 


task  CONSUME_ITEM; 

—  A  task  which  processes  data  one  item  at  a  time. 

—  Structure  of  data  blocks  is  unimportant  to  this  task. 


task  B LOC K_T 0_I TEM  is 

—  A  task  to  allow  PRODUCE_BLOCK  to  feed  CONSUME_ITEM . 
entry  SEND_BLOCK  (B  :  in  BLOCK); 

—  A  call  to  SEN DEBLOCK  is  accepted  first, 
entry  GET_ITEM  (ITEM  :  out  INTEGER); 

—  100  (BLOCK_LENGTH)  calls  to  GET_ITEM  are  then  accepted 

—  before  looping  back  to  the  accept  for  SEND_BLOCK. 

end  BLOCK  TO  ITEM; 
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task  body  BLOCK_TO  ITEM  is 
BUFFER  s  BLOCK;” 
beg  in 

loop  —  forever 

accept  SEND  BLOCK  (B  s  in  BLOCK)  do 
BUFFER  :  =  B; 
end  SEND  BLOCK; 
for  I  in~l. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  :=~BUFFER(I) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_B LOC K  is 
MY_BLOCK  :  BLOCK; 
beg  in 
loop 


—  fill  MY  BLOCK  from  somewhere 


B LOC K_TO_ITEM.SEND_B LOCK  (MY_BLOCK) ; 
end  loop; 

end  PRODUCE  BLOCK; 


l 


task  body  CONSUME_ITEM  is 
NEXT_ITEM  :  INTEGER; 

beg  in 

loop 

BLOCK_TO_ITEM.GET_ITEM  (NEXT_ITEM) ; 
—  consume  NEXT_ITEM 

end  loop; 
end  CONSUME  ITEM; 


E 
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task  BLOCK_TO_ITEM  is 

—  task  specification 

—  contains  entry  declarations  only 

end  BLOCK  TO  ITEM; 


task  body  BLOCK  TO__ITEh  is 

—  declarative  part 
beg  in 

—  sequence  of  statements 


end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 

•  •  • 

...  —  fill  MY  BLOCK  from  somewhere 
•  •  • 

BLOCK_TO_ITEM . SEND_B LOC K (MY_B LOCK) ;  —  entry  call 

•  •  • 

end  PR ODUC E_B  LOC  K ; 

task  body  BLOCK_TO_ ITEM  is 
•  •  • 

accept  SEND  B LOC K { B  :  in  BLOCK)  do 
BUFFER  :=  B 
end  SEND_BLOCK; 

•  •  • 

end  BLOCK  TO  ITEM; 
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fill  MY_B LOCK 
from  somewhere 


t 


BLOCK_TO_ITEM. 
SEND_BLOCK 
(MY  BLOCK) 


T 


t 


accept  SEND_BLOCK 
(B  :  in  BLOCK) 


T 

I 


RENDEZVOUS 


BUFFER  :=  B 
executed 


ENTRY  DECLARATION 
and 

ENTRY  CALL 


ENTRY  declaration 

Similar  to  a  procedure  declaration  in  syntax 
Can  be  declared  only  in  a  task  specification 

ENTRY  call 

Same  syntax  as  subprogram  calls 
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ACCEPT  STATEMENT 


accept  entry_name 


formal  part 


(optional) 


do  sequence_of_statements  end  (optional) 


formal_part 

analogous  to  subprogram  formal_part; 
specifies  parameters,  their  inodes  and  types 


do  sequence_of_statements  end 

when  rendezvous  occurs  (entry  has  been  called  and 
accept  statement  is  reached)  sequence_of_statements 
is  executed 
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task  body  BLOCK  TO  ITEM  is 
BUFFER  :  BLO^K;” 
beg  i  ft 

loop  —  forever 

accept  SEND_B LOCK  (B  :  in  BLOCK)  do  <<======= 

BUFFER  :=  B; 
end  SEND_B LOCK; 
for  I  in  1. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  :=  BUFFER (I); 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_BLOCK  :  BLOCK; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


BLOCK_TO_ITEM  .  SEND_B  LOCK  (MY_B  LOCK)  ; 
end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME_iTEM  is 
NEXT  ITEM  :  INTEGER; 


beg  in 
loop 

BLOCK_TO_ITEM . GETITEM  (NEXT  ITEM); 
—  consume  NEXT  ITEM 


<<  =  =  =  =  =  =:  = 


end  loop; 
end  CONSUME  ITEM; 
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task  body  B10CK_T0_ITEM  is 
BUFFER  :  BLOCK; 
beg  in 

loop  —  forever 

accept  SEND  BLOCK  (B  :  in  BLOCK)  do  <<««*»=*= 

BUFFER  :=  B; 
end  SEND  BLOCK; 
for  I  in  1.. BLOCK  LENGTH  loop 

accept  GET_ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  : *  BUFFER (I); 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_BLOCK  :  BLOCK; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


B LOC K_T 0_ ITEM. SEN D_B LOCK  (MY^BLOCK)  ;  <<«»»»«*= 

end  loop? 
end  PRODUCE  BLOCK; 


task  body  CONSUME_ITEM  is 
NEXT_ITEM  ;  INTEGER; 
beg  in 
loop 

BLOCK  TO_ITEM.GET_ITEM  (NEXT_ITEM) ;  << 

—  consume  NEXT  ITEM 


end  loop; 
end  CONSUME  ITEM; 
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m 


task  body  BLOCK  TO_ITEM  is 
BUFFER  :  BLOCK; 
beg  in 

loop  —  forever 

accept  SEND  BLOCK  (B  :  in  BLOCK)  do 
BUFFER  :■  B; 
end  SEND  BLOCK; 
for  I  in  1.. BLOCK  LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do  <<«*=*»«= 
ITEM  :*"BUFFER(I) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_B LOCK  :  BLOCK; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


<<=  = 


BLOCK_TO_ITEM.SEND_BLOCK  (MY_BLOCK)  ; 
end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME_ITEM  is 
NEXT_ITEM  :  INTEGER; 
beg  in 
loop 


BLOCK_TO_ITEM . GET  ITEM  (NEXT_ITEM) ; 
—  consume  NEXT  ITEM 


<<======= 


end  loop; 
end  CONSUME  ITEM; 
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task  body  BLOCK_TO  ITEM  is 
BUFFER  :  BLOCK;” 
beg  in 

loop  —  forever 

accept  SEND_B LOC K  ( B  :  in  BLOCK)  do 
BUFFER  B; 
end  SEND  BLOCK; 
for  I  in  1. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do  «•-»»*»= 
ITEM  s="BUFFER(I) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_BLOCK  :  BLOCK; 
beg  in 
loop 

—  fill  MY_BLOCK  from  somewhere 

<< 


B LOC K_TO_ITEM.SEND_B LOCK  ( MY_B LOCK) ; 
end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME_iTEM  is 
NEXT_ITEM  :  INTEGER; 
beg  in 
loop 

BLOCK_TO_ITEM . GET  ITEM  (NEXT_ITEM)  ; 

—  consume  NEXT_lTEM 

;  <<«»«» 

e 

end  loop; 
end  CONSUME  ITEM; 
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task  body  BLOCK  TO_ITEM  is 
BUFFER  :  BLOCK; 
beg  in 

loop  —  forever 

accept  SEND  BLOCK  (B  ;  in  BLOCK)  do 
BUFFER  :=  B; 
end  SEND_B LOCK; 
for  I  in  1. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do  <<« 
ITEM  :=  BUFFER (I) ; 
end  GET_ITEM; 
end  loop;  *~ 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_BLOCK  s  BLOCK; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


B LOC K_TO_ITEM . SEND_B LOC K  (MY_BLOCK) ;  <<* 

end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME  ITEM  is 
NEXT_ITEM  :  INTEGER; 
beg  in 
loop 

BLOCK_TO_ITEM.GET_ITEM  (NEXT  ITEM);  <<* 

—  consume  NEXT  ITEM 


end  loop; 
end  CONSUME  ITEM; 


task  body  BLOCK  TO_ITEM  is 
BUFFER  :  BLOCK; 
begin 

loop  —  forever 

accept  SEND_B LOC K  (B  :  in  BLOCK)  do  <<**  =  = 

BUFFER  :  =  B; 
end  SEND_BLOCK; 
for  I  in  1.. BLOCK  LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  : -“BUFFER (I ) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


task  body  PRODUCE_BLOCK  is 
MY_BLOCK  :  BLOCK; 
begin 
loop 

—  fill  MY  BLOCK  from  somewhere 


B LOC K_TO_ITEM.SEND_B LOCK  (MY_BLOCK) ;  <<  =  =  = 

end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME  ITEM  is 
NEXT_ITEM  :  INTEGER; 
be 3  in 
loop 

BLOCK  TO_ITEM . GET  ITEM  (NEXT_ITEM) ; 
—  consume  NEXT_lTEM 


end  loop; 
end  CONSUME  ITEM; 
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VERSION  2  -  STRUCTURE 


—  An  example  of  cooperating  tasks  running  in  parallel , 

—  within  a  complete  program 

procedure  MAIN; 

task  B LOC K_T 0_I TEM  is  ...  ; 
task  PRODUCE  BLOCK; 
task  CONSUME'ITEM; 

task  body  BLOCK_TO_ITEM  is  ...  ; 
task  body  PRODUCE_BLOCK  is  ...  ; 
task  body  CONSUME_ITEM  is  ...  ; 

begin  —  body  of  MAIN 

loop 

delay  15.0  *  SECONDS; 

exit  when  PRODUCE_B LOCK 'TERMINATED 
and  CONSUME_ITEM' TERMINATED; 
end  loop; 


abort  BLOC K_TO_I TEM; 
end  MAIN; 
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Task  Bodies 


task  body  PRODUCE_BLOCK  is 
MY  BLOCK  :  BLOCK; 

NO~MORE_B LOCKS  :  BOOLEAN  :=  FALSE; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


if  NO_MORE_B  LOCKS  THEN 

—  Call  SEND  BLOCK  with  some  indication  of  end 
—  of  data,  Tor  example  a  block  of  negative  values, 
exit; 
end  i f  ; 

BLOCK_TO_ITEM.SEND_BLOCK  (MYJBLOCK)  ; 
end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME_ITEM  is 
NEXT_ITEM  ;  INTEGER; 
beg  in 
loop 

B LOC K_TO_I TEM . GET_I TEM  (NEXT_ITEM)  ; 
exit  when  NEXT_ITEM  <  0; 

—  consume  NEXT  ITEM 


end  loop; 
end  CONSUME  ITEM; 


task  body  B LOCK_TO_I TEM  is 
BUFFER  :  BLOCK; 
beg  in 

loop  —  forever 

accept  SEND  BLOCK  (B  :  in  BLOCK)  do 
BUFFER  :  =  B; 
end  SEND  BLOCK; 
for  I  in“l. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  ;  out  INTEGER)  do 
ITEM  : =“ BUFFER ( I ) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 


TASK  AND  ENTRY  ATTRIBUTES 


For  a  task  T,  the  following  attributes  are  defined: 

T'TERMINATED  of  type  BOOLEAN  -  initially  equal  to  FALSE 
when  a  task  is  created  and  becomes  TRUE  when 
the  task  terminates 

T'STACK_SIZE  inidicates  the  number  of  storage  units 
allocated  for  the  task  (an  integer  number) 

T' PRIORITY  of  predefined  type  PRIORITY 

Defined  in  package  STANDARD: 

subtype  PRIORITY  is  INTEGER  range  implementation  defined; 


PRIORITY  is  set  by  the  optional  appearance  of 

pragma  PRIORITY  <static_expression) ; 

somewhere  within  a  task  specification. 

If  processor  resources  are  shared,  an  eligible  task 
with  the  highest  priority  is  executed. 

The  priority  of  a  task  is  static . 


For  an  entry  E  of  Task  T,  the  following  attribute  can  be  used 
within  the  body  of  task  T: 

E 'COUNT  The  number  of  entry  calls  presently  queued 

on  the  queue  associated  with  entry  E. 

An  integer  number. 
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The  DELAY  Statement 


Suspends  the  task  which  executes  it  for  at  least  the  given 
time  interval. 


delay  simple_expression; 


SECONDS  is  a  predefined  constant  defined  in  STANDARD  package 
(implementation  defined).  It  gives  the  number  of 
basic  time  units  in  one  second. 
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The  ABORT  Statement 


Example : 

abort  BLOCKJTO_ITEM; 

Causes  unconditional  asynchronous  termination  of  task(s). 

If  a  task  calling  an  entry  is  abnormally  terminated,  it  is 
removed  from  the  entry  queue;  if  the  rendezvous  is  already 
in  progress,  the  calling  task  is  terminated  but  the  task 
executing  the  accept  statement  is  allowed  to  complete  the 
rendezvous  normally. 

If  there  are  pending  entry  calls  for  the  entries  of  a  task 
that  is  abnormally  terminated,  an  exception  TASKING_ERROR  is 
raised  for  each  calling  task  at  the  point  where  it  calls  the 
entry,  including  for  a  task  presently  engaged  in  a  rendez¬ 
vous,  if  any. 

ABORT  statements  are  almost  never  needed  and  should  only  be 
used  when  no  other  feature  can  do  a  job. 


a 


Example  VIII 
Version  2 

—  An  example  of  cooperating  tasks  running  in  parallel, 

—  within  a  complete  program. 

procedure  MAIN; 


BLOCK_LENGTH  ;  constant  INTEGER  :«  100; 

type  BLOCK  is  array  (1.. BLOCK  LENGTH)  of  INTEGER; 


task  PRODUCEJBLOCK; 

—  A  task  which  produces  blocks  of  data  items  from  any  source. 

—  Each  block  is  BLOCK  LENGTH  data  items  long. 


task  CONSUME_ITEM; 

—  A  task  which  processes  data  one  item  at  a  time. 

—  Structure  of  data  blocks  is  unimportant  to  this  task. 


task  BLOC K_TO_I TEM  is 

—  A  task  to  allow  PRODUCE  BLOCK  to  feed  CONSUME  ITEM, 
entry  SEND_BLOCK  (B  :  in  BlOCK) ; 
entry  GET  ITEM  (ITEM  :  out  INTEGER); 
end  BLOCK  TO~ITEM; 


task  body  BLOC K_TO_I TEM  is 
BUFFER  ;  BLOCK; 
beg  in 

loop  —  forever 

accept  SEND_B LOCK  (B  :  in  BLOCK)  do 
BUFFER  :■  B; 
end  SEND  BLOCK; 
for  I  in~l. .BLOCK_LENGTH  loop 

accept  GET  ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  : =~BUFFER ( I ) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK  TO  ITEM; 
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task  body  PRODUCE_BLOCK  is 
MY  BLOCK  :  BLOCK; 

NO“MORE_B LOCKS  :  BOOLEAN  :*  FALSE; 
begin” 
loop 

—  fill  MY_B LOC K  from  somewhere 

.  —  N 0_M OR E_B LOCKS  may  be  changed  in  here 

• 

if  NO_M OR E_B LOCKS  THEN 

— “Call  SEND  BLOCK  with  some  indication  of  end 
—  of  data.  Tor  example  a  block  of  negative  values, 
exit; 
end  if; 

BLOCK_TO_ITEM . SEND_B LOCK  (MY_B LOCK) ; 
end  loop; 

end  PRODUCE_B LOCK; 

task  body  CONSUME_ITEM  is 
NEXT_ITEM  :  INTEGER; 
beg  in 
loop 

BLOCK_TO_ITEM.GET_ITEM  (NEXT_ITEM)  ; 
exit  when  NEXT_ITEM  <  0; 

—  consume  NEXT  ITEM 


end  loop; 
end  CONSUME  ITEM; 


begin  —  body  of  main 

—  There  is  nothing  to  be  done  in  this  body,  but  it 
—  will  not  terminate  until  all  three  tasks  terminate. 
—  However,  BLOCK_TO_ITEM  loops  forever. 

—  A  possible  solution  is  to  wait  for  the  other  two: 

loop 

delay  15.0  *  SECONDS; 
exit  when  PRODUCE  BLOCK ’ TERMINATED 
and  CONSUME_ITfM' TERMINATED; 
end  loop; 

abort  BL0CK_T0_ITEM; 
end  MAIN; 


VIII. 310 


VERSION  3  -  STRUCTURE 


—  An  example  of  cooperating  tasks  running  in  parallel, 

—  within  a  complete  program  with  improved  termination. 

procedure  MAIN; 

task  BLOCK_TO_ITEM  is  ...  ; 
task  body  B LOC K_TO_ ITEM  is  ...  ; 
begin  —  body  of  MAIN 
declare 

task  PR ODUC E_B LOC K ; 
task  CONSUME_ITEM; 

task  body  PRODUCE_BLOCK  is  ...  ; 
task  body  CONSUME_ITEM  is  ...  ; 

begin  —  body  of  block 

null ; 

—  This  block  will  terminate  only  after  the  two  tasks 

—  declared  within  it  terminate.  Each  explicitly  does 

—  so,  thus  exit  from  this  block  is  guaranteed  and  only 
—  BLOCK_TO_ITEM  will  still  be  active  at  that  time. 

end ; 

—  BLOCK_TO  ITEM  must  now  be  terminated  to  enable  the 

—  termination  of  this  procedure. 

abort  BLOCK_TO_ITEM ; 
end  MAIN; 


Example  VIII 
Version  3 


—  An  example  of  cooperating  tasks  running  in  parallel* 

—  within  a  complete  program  with  improved  termination. 

procedure  MAIN; 

BLOCK_LENGTH  :  constant  INTEGER  100; 

type  BLOCK  is  array  (1.  .BLOCK__LENGTH)  of  INTEGER; 

task  BL0CK_T0  ITEM  is 

—  A  task  to  allow  PRODUCE  BLOCK  to  feed  CONSUME_ITEM. 
entry  SEND_BLOCK  (B  s  in  BLOCK); 
entry  GETJTEM  (ITEM  :  out  INTEGER); 
end  BLOCK_TO_ITEM; 

task  body  BLOCK  TO  ITEM  is 
BUFFER  :  BLOCK;" 
beg  in 

loop  —  forever 

accept  SEND_BLOCK  (B  :  in  BLOCK)  do 
BUFFER  B; 
end  SEND_B LOCK; 
for  I  in"l. .BLOCK_LENGTH  loop 

accept  GET_ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  :=~BUFFER(I) ; 
end  GET_ITEM; 
end  loop; 
end  loop; 

end  BLOCK_TO_ITEM; 
begin  —  body  of  MAIN 

declare  —  a  block  to  declare  the  other  two  tasks 
task  PRODUCE_BLOCK; 

—  A  task  which  produces  blocks  of  data  items  from  any 
—  source.  Each  block  is  BLOCK_LENGTH  data  items  long. 

task  CONSUME_ITEM ; 

—  A  task  which  processes  data  one  item  at  a  time. 

—  Structure  of  data  blocks  is  unimportant  to  this  task. 
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task  body  PRODUCE_BLOCK  is 
MY  BLOCK  :  BLOCK; 

NO"MORE_B LOCKS  :  BOOLEAN  :=  FALSE; 
beg  in 
loop 

—  fill  MY  BLOCK  from  somewhere 


if  NO_MORE_B LOCKS  THEN 

— ~ Call  SEND_BLOCK  with  some  indication  of  end 
—  of  data,  for  example  a  block  of  negative  values, 
exit; 
end  if; 

BLOCK_TO_ITEM .  SEND_B LOCK  (MY_B LOCK)  ; 
end  loop; 

end  PRODUCE  BLOCK; 


task  body  CONSUME_ITEM  is 
NEXT_ITEM  :  INTEGER; 
begin 


loop 

BLOCK  TO_ITEM . GET  ITEM  (NEXT_ITEM) 
exit  when  NEXT_ITliM  <  0; 

—  consume  NEXT  ITEM  ' 


end  loop; 
end  CONSUME  ITEM; 


begin  —  body  of  block 
null; 

—  This  block  will  terminate  only  after  the  two  tasks  . 

—  declared  within  it  terminate.  Each  explicitly  does 

—  so,  thus  exit  from  this  block  is  guaranteed  and  only; 
—  BLOCK_TO_ITEM  will  still  be  active  at  that  time. 

end ; 

—  BLOCK  TO  ITEM  must  now  be  terminated  to  enable  the 

—  termination  of  this  procedure. 

abort  BLOCK  TO  ITEM; 


1. 

L 


end  MAIN; 
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VERSION  4  -  STRUCTURE 
(same  as  VERSION  3) 


—  The  previous  example  is  now  modified  to  allow 

—  BLOCK  TO  ITEM  to  buffer  several  blocks  if  PRODUCE  BLOCK 

—  gets  ahead  of  CONSUME_ITEM. 

procedure  MAIN; 

BLOCK_LENGTH  :  ...  ; 
type  BLOCK  is  ...  ; 

task  BLOCKJTO  ITEM  is  ...  ; 
task  body  BLOCK_TO_ITEM  ...  ; 

begin  —  body  of  MAIN 

declare 

task  PRODUCE_B LOCK; 
task  CONSUME_ITEM; 

task  body  PRODUCE_BLOCK  is  ...  ; 
task  body  CONSUME_ITE  is  ...  ; 

begin  —  body  of  block 

end; 

abort  BLOCK  TO  ITEM; 


end  MAIN; 


r 


J 
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Use  of  a  Block  Buffer 


BLOCK  LENGTH  :  constant  INTEGER  :=  100; 
type  Slock  is  array  ( 1.  .BLOCKJ.ENGTH)  of 


INTEGER; 


BUFFER  SIZE  :  constant  INTEGER  :*  10; 
BUFFER-:  array  (1.  .BUFFER__SIZE)  of  BLOCK; 


IN  INDEX 
"  I 
I 

T 

p*,***'r*-****  i  *****  i  *  *  *  *  *  ]  i  i  i  i 

j ***** | ***** j ***** i ***** i  i  i  i  i 

i  *****  |  *****  |  *****  |  *****  i _ i _ i _ i _ i 


i 

i 

OUT_INDEX 

BLOCK  COUNT  *  4 


The  filling  (production)  of  blocks  and  the  use  (consumption) 
of  items  can  be  carried  out  in  parallel. 

Several  blocks  may  be  buffered. 


* 
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SELECT  STATEMENT 


Selective  Wait 


select 

alternative  1 
or  alternative  2  \ 

\ 

...  > 

/ 

or  alternative_n  / 

else 

sequence_o  f_statements 
end  select; 


zero  or  more  times 


\ 

>  optional 

/ 


Each  alternative  is  composed  of 

1.  (optional)  "guard":  when  condition  => 

2.  accept_statement 

3.  (optional)  sequence  of  statements 
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Selective  Wait  -  Open  Alternatives 

select 

accept  entry_namel; 
or  accept  entr y_name_2; 

•  •  • 

or  accept  entry_name_n; 
end  select ; 


o  Select  one  of  the  open  alternatives  (accept  statements)  if 
a  corresponding  rendezvous  is  possible.  An  alternative 
is  "open"  if  there  is  no  guard.  Rendezvous  is  possible 
when  a  corresponding  entry  call  has  been  issued  by 
another  task. 

o  When  several  alternative  rendezvous  arc  possible  and/or  1 

several  open  alternatives  start  with  i»n  accept  statement 
for  the  same  entry  one  of  the  alternatives  will  be 
selected  at  random. 

o  If  no  alternative  can  be  immediately  selected,  task  waits 
until  alternative  can  be  selected. 


j 
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Selective  Wait  -  Use  of  Guards 


select 


when  guard_l  => 
accept  entry_name_l; 

or  when  guard__2  => 

accept  entFy_name_2; 

or  accept  entry_name_3; 


end  select ; 


An  alternative  with,  a  guard  is  open  if  the  corresponding 
condition  is  true. 
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Body  of  BLOCK_TO_ITEM 

task  body  BL0CK_T0_ITEM  is 

BUFFER_SIZE  :  constant  INTEGER  :=  10; 

BUFFER  :  array  ( 1. .BUFFER_SIZE)  of  BLOCK; 

BL0CK_C0UNT  :  INTEGER  range  0  ..  BUFFER_SIZE  ;«  0; 

IN  INDEX,  0UT_INDEX  :  INTEGER  range  1  ..  BUFFER_SIZE  :=  1; 
ITEM_INDEX  :  INTEGER  range  1  ..  BLOCKLENGTH  :*  1; 

beg  in 

loop  —  forever 
select 

when  BLOCK_COUNT  <  BUFFER__SIZE  => 

accept  SEND_BLOCK  (B  :  in  BLOCK)  do 
BUFFER (IN_INDEX)  :=  B; 
end  SEND_BLOCK; 

IN_IND£X  :=  IN_INDEX  mod  BUFFER_SIZE  +  1; 
BLOCK_COUNT  :«  BLOCK_COUNT  +  1; 
or  when  BL0CK_C0UNT  >  0  *> 

accept  GET_ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  BUFFER (0UT_INDEX,  ITEM_INDEX) ; 
end  GET_ITEM; 

ITEM_INDEX  :=  ITEM_INDEX  mod  BLOCK_LENGTH  +  1; 
if  ITEM_INDEX  =  1  then 

—  a  block  has  been  consumed 
OUT_INDEX  :=  0UT_INDEX  mod  BUFFER_SIZE  +  1; 
BL0CK_C0UNT  :=  BL0CK_C0UNT  -  1; 
end  if; 
end  select; 
end  loop; 

end  BLOCK  TO  ITEM; 
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Example  VIII 
Version  4 


—  The  previous  example  is  now  modified  to  allow 

—  B LOC K_T 0_  I T  EM  to  buffer  several  blocks  if  PRODUCE  BLOCK 

—  gets  ahead  of  CONSUME_ITEM. 

procedure  MAIN  is 

BLOCK_LENGTH  :  constant  INTEGER  :=  100; 

type  BLOCK  is  array  ( 1. .BLOCK_LENGTH)  of  INTEGER; 

task  BLOCK  TO_ITEM  is 

—  A  task  to  allow  PRODUCE  BLOCK  to  feed  CONSUME  ITEM, 
entry  SEND_BLOCK  (B  :  in  BlOCK) ; 
entry  GET  ITEM  (ITEM  :  out  INTEGER); 
end  BLOCK_TO~ITEM; 

task  body  BLOC K_T 0_ I T EM  is 

BUFFER_SIZE  :  constant  INTEGER  :=  10; 

BUFFER  :  array  ( 1 . . BUFFER_SIZ E)  of  BLOCK; 

BLOCK_COUNT  :  INTEGER  range  0  ..  BUFFER_S IZE  :=  0; 
IN_INDEX,  OUT_INDEX  :  INTEGER  range  1  ..  BUFFER_SIZE  :=  1; 
ITEM_INDEX  :  INTEGER  range  1  ..  BLOCK_LENGTH  :=  1; 
begin 

loop  —  forever 
select 

when  BLOC K_COUNT  <  BUFFER_SIZE  => 

accept  5END_BL0CK  (B  ;  in  BLOCK)  do 
BUFFER (IN_INDEX)  B; 
end  SEND_B LOCK ; 

IN_INDEX  :=  IN_INDEX  mod  BUFFER_SIZE  +  1; 
BLOCK_COUNT  :=  BLOCK_COUNT  +  1; 
or  when  BLOCK  COUNT  >  0  => 

accept  GET_ITEM  (ITEM  :  out  INTEGER)  do 
ITEM  :=  BUFFER (OUT  INDEX,  ITEM  INDEX); 
end  GET_ITEM ; 

ITEM  INDEX  :=  ITEM_INDEX  mod  BLOCK  LENGTH  +  1; 
if  ITEM_INDEX  =  1  then 

—  a  block  has  been  consumed 

OUT_INDEX  :=  OUT_INDEX  mod  B UFFER_S IZE  +  1; 

B  LOC  K_C0UNT  :=  BL0CK_C0UNT  -  1; 
end  if; 
end  select; 
end  loop; 

end  BLOCK  TO  ITEM; 
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begin  —  body  of  MAIN 


declare  —  a  block  to  declare  the  other  two  tasks 
task  PRODUCE_BLOCK; 

—  A  task  which  produces  blocks  of  data  items  from  any 
—  source.  Each  block  is  B LOCK_LENGTH  data  items  long. 

task  C0NSUME_ITEM; 

—  A  task  which  processes  data  one  item  at  a  time. 

—  Structure  of  data  blocks  is  unimportant  to  this  task. 

task  body  PRODUCE_BLOCK  is 
MY_BLOCK  :  BLOCK; 

NO_MORE_B LOCKS  ;  BOOLEAN  :=  FALSE; 
begin- 
loop 

—  fill  MY  BLOCK  from  somewhere 


• 

if  N0_M0RE  BLOCKS  THEN 

—  Call  SEND  BLOCK  with  some  indication  of  end 
—  of  data,  Tor  example  a  block  of  negative  values, 
exit; 
end  i f ; 

B  LOC  K_TO_I TEM . SEND_B LOC  K  ( M Y_B  LOC  K) ; 
end  loop; 

end  PRODUC E_B  LOC K ; 

task  body  CONSUME_ITEM  is 
NEXT_ITEM  :  INTEGER; 
beg  in 
loop 

BLOCK  TO  ITEM .GET_ITEM  (NEXT_ITEM) ; 
exit  when  NEXT_ITEM  <0; 

—  consume  NEXT  ITEM 


end  loop; 
end  CONSUME_ITEM ; 

begin  —  body  of  block 

null ; 

—  This  block  will  terminate  only  after  the  two  tasks 

—  declared  within  it  terminate.  Each  explicitly  does 

—  so,  thus  exit  from  this  block  is  guaranteed  and  only 
—  BL0CK_T0_ITEM  will  still  be  active  at  that  time. 

end; 

—  BL0CK_T0  ITEM  must  now  be  terminated  to  enable  the 
—  termination  of  this  procedure, 
abort  BLOCK  T0_ITEM; 
end  MAIN; 
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Selective  Wait  -  Else  Part 

select 

al ternative_l ; 

or  alternative_2; 

•  •  • 

or  al ternative_n ; 
else 

sequence_of_statements 
end  select ; 


o  Alternative  selected  as  before. 

o  If  no  alternative  can  be  immediately  selected,  the  else 
part  is  executed. 
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I  Selective  Wait  -  SELECT  ERROR 


select 


guard__l  => 

accept  entry_name__l; 


or  guard_2  *> 

accept  entr y_name_2; 


or  guard__3  *> 

accept  entr y_name_3; 

end  select; 


If  all  alternatives  are  closed  (all  guards  are  FALSE)  then 
the  exception  SELECT  ERROR  is  raised. 


i 

l 
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Forms  of  Alternatives 

when  condition  «> 
accept  entry_name 
do  sequence_of_statements  end 
sequence  of  statements 

when  condition  *> 
delay_statement 
sequence_of_statements 

when  condition  => 
terminate 


An  open  alternative  starting  with  a  delay  statement  will  be 
selected  if  no  other  alternative  has  been  selected  before 
the  specified  time  interval  has  elapsed. 


A  selective  wait  can  contain  at  most  one  terminate  alter¬ 
native.  An  open  terminate  alternative  will  be  selected  only 
if  the  end  of  the  program  unit  containing  the  task  has  been 
reached  and  all  other  tasks  depending  on  that  program  unit 
have  either  terminated  or  are  waiting  at  a  selective  wait 
with  a  terminate  alternative. 


An  alternative  starting  with  a  delay  statement,  a  terminate 
alternative  and  an  else  part  are  mutually  exclusive. 


r 

I 

I 
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select 


when  guard_l  *> 
entr  y_name_l ; 
or 

when  guard_2  *> 
entr y_naroe_2; 
or 

when  guard-3  *> 

delay  expression-1 
or 

delay  expression-2; 
end  select ; 


\ 

\  Both  could 

/  be  open 

/ 


only  the  one 
with  the 
shortest  time 
interval  is 
selected . 


BLOCK  TO  ITEM  with  Terminate  Alternative 


task  body  BLOCK  TO  ITEM  is 

BUFFER  SIZE  7  constant  INTEGER  :*  10; 

BUFFER”:  array  ( 1 . .BUFFER_SIZE)  of  BLOCK; 

BLOCK  COUNT  :  INTEGER  range  0  ..  BUFFER  SIZE  :*  0; 
IN_INl5EX,  OUT  INDEX  :  INTEGER  range  1  .7  BUFFER_SIZE  :*  1; 
ITEM_INDEX  :  INTEGER  range  1  . .  B LOCK__LENGTH  :*  1; 
begin  ~ 

loop  --  forever 

select 

when  BLOCK  COUNT  <  BUFFER_SIZE  *> 

accept  SENDJBLOCK  (B  :  in  BLOCK)  do 
BUFFER (IN  INDEX)  :«  B; 
end  SEND  BLO?K; 

IN_INDEX” : *  IN_INDEX  mod  BUFFER_SIZE  +  1; 

BLOCK  COUNT  :  =*"BLOCK_COUNT  +  1; 

or  when  BLOCK  COUNT  >  0  *> 

accept  GET_ITEM  {ITEM  :  out  INTEGER)  do 
ITEM  :=  BUFFER (OUT  INDEX,  ITEM  INDEX); 
end  GET_ITEM; 

ITEM  INDEX  :=  ITEM  INDEX  mod  BLOCK  LENGTH  +  1; 
if  lTEM_IND£X  =  1  then 

—  a  block  has  been  consumed 
OUT  INDEX  :=  OUT_INDEX  mod  BUFFER_SIZE  +  1; 
BLO?K_COUNT  :«  BlOCK_COUNT  -  1;  ~ 

end  if; 

or  terminate;  —  allows  termination  at  end  of  block 
end  select; 
end  loop; 

end  BLOCK  TO  ITEM; 
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VERSION  5  -  STRUCTURE 


With  use  of  the  version  of  BLOCK  TO  ITEM  just  presented,  we 
can  restructure  our  example  as  follows,  completely  eliminat¬ 
ing  the  use  of  abort . 


procedure  MAIN; 

task  BLOCK_TO_ITEM  is  ...  ; 
task  PRODUCE  BLOCK; 
task  CONSUME_ITEM; 

task  body  BLOCK_TO_ITEM  is  ...  ; 
task  body  PRODUCER  LOCK  is  ...  ; 
task  body  CONSUME~ITEM  is  ...  ; 

begin  —  body  of  MAIN 

null ; 

—  await  termination  of  tasks 
end  MAIN; 
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SELECT  STATEMENT 


i. 

i 

1 

| 

| 

i 


Conditional  Entry  Calls 


select 

entry  call 

sequence_of_statements  —  optional 
else 

sequence_o f_statements 
end  select ; 


A  conditional  entry  call  issues  an  entry  call  if  and  only  if 
this  entry  can  be  accepted  immediately. 


r 

* 
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SELECT  STATEMENT 


Timed  Entry  Calls 


select 

entry  call 

sequence_of_statements  —  optional 
or 

delay_statement 

sequence_of_statements  —  optional 
end  select; 


A  timed  entry  call  issues  an  entry  call  if  and  only  if  this 
entry  can  be  accepted  within  a  given  delay. 
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EXCEPTIONS  IN  TASKS 


If  an  exception  is  raised  in  the  sequence  of  statements  of  a 
task  body  that  does  not  contain  a  handler  for  the  exception* 
the  execution  of  the  task  is  abandoned;  that  is*  the  task  is 
terminated ♦  The  exception  is  not  propogated  further . 


Each  task  has  an  attribute  named  FAILURE  which  is  an  excep¬ 
tion.  Any  task  can  raise  the  FAILURE  exception  in  any  task 
which  it  can  name  (for  example  T)  by  the  statement 

raise  T' FAILURE; 

The  exception  FAILURE  supersedes  any  other  exception  that  is 
not  yet  handled  or  that  is  received  while  handling  FAILURE. 
Within  the  body  of  a  task  type  T  (and  only  there)  there  may 
be  handlers  for  the  exception  T'FAILURE. 
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SUMMARY 


Task  Concepts 
Entries 

Accept  Statements 
Rende zvous 

Task  Attributes 


Select  Statements 


A  TEXT  FORMATTER 


Default  Operation  j 

i 

i 

By  default,  output  lines  are  filled  and  right  justified 

(by  inserting  extra  spaces  between  words) .  j 

I 

Line  spacing  is  1. 

Right  margin  is  set  at  column  60. 

Page  length  is  set  at  66  with  a  four  line  margin 
at  the  top  and  bottom  of  the  page. 

Leading  spaces  on  a  line  cause  a  temporary  indentation.  \ 

A  blank  line  causes  a  break  before  it  is  transmitted  to 
the  output.  (A  break  terminates  the  current  output 
line  in  fill  mode.) 


COMMAND  SUMMARY 


command 

break? 

default 

function 

.bp 

yes 

begin  page 

.br 

yes 

cause  a  break 

.ce  n 

yes 

n=l 

center  next  n  lines 

.f  i 

yes 

start  filling 

.in  n 

no 

o 

II 

c 

indent  n  spaces 

.Is  n 

no 

n=l 

line  spacing  is  n 

•  nf 

yes 

stop  filling 

.pi  n 

no 

n=66 

set  page  length  to  n 

.rm  n 

no 

n=60 

set  right  margin  to  n 

•  sp  n 

yes 

n=l 

space  down  n  lines 

.ti  n 

yes 

o 

ii 

c 

temporary  indent  of  n 

A  in  column  1  is  an  indication  of  a  command  line. 


Signs  are  optional  on  command  parameters;  the  presence  of  a 
sign  indicates  a  that  the  new  value  is  relative  to  the  old. 


Main  Program  Design 


procedure  FORMAT 


begin 

Initial i ze 

while  more  input  is  available  loop 
Get  next  line 
if  line  is  a  command  then 
Process  command 
else 

Process  text 
end  if 
end  loop 
Terminate 
end  FORMAT 


Command  Processing  Design 
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Text  Processing  Design 


procedure  TEXT 


begin 

handle  leading  blanks 

if  line  to  be  centered  then 
align  text 
put  out  line 

elsi f  line  is  blank  then 
put  out  line 

elsi f  not  in  fill  mode  then 
put  out  line 

else  —  handle  word-by-word 
loop 

get  a  word 

exit  when  no  more  words 
put  out  word 
end  loop 
end  i  f 


end  TEXT 


Collect  subprograms  which  handle  input  and  manipulate  the  input 
buffer  into  a  package,  with  the  buffer  hidden  within  the  body. 


package  INPUT_HANDLER  is 

type  COMMANDS  is  ( BP,BR,CE,FI, IND, LS,NF,PL, 
RM,SP,TI, UNKNOWN) ; 

type  SIGN_TYPE  is  (PLUS,  MINUS,  NONE,  NO  PARAM) ; 

MAX  WORD  SIZE  :  constant  INTEGER  :=  20;  ~ 
subfype  WORD  STRING  is  STRING  (1  ..  MAX  WORD  SIZE); 


function  READ  LINE  return  BOOLEAN; 

—  Reads  a  line  into  an  internal  buffer;  returns 
—  FALSE  when  no  more  lines  are  available 


—  Command-related  functions 
function  IS  COMMAND  return  BOOLEAN; 

—  TRUE  T f  line  starts  with  a 
function  COMMAND  TYPE  return  COMMANDS 
procedure  GET_VAtUE  (SIGN  :  out  SIGNJTYPE; 

VALUE  :  out  INTEGER) ; 

—  Reads  parameters  to  commands,  when  present. 


—  Text  processing  functions 
procedure  PROCESS  BLANKS; 

—  Handles  leeJing  blanks 
procedure  CENTER; 

function  BLANK_LINE  return  BOOLEAN; 
procedure  NEXT  WORD  (WORD  :  out  WORD  STRING; 

LENGTH  :  out  INTEGER); 
function  LINE  return  STRING; 

—  used  to  send  a  whole  line  to  FORMATTER 

—  after  centering  and  leading  blank  removal. 

end  INPUT  HANDLER; 
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Collect  subprograms  which  affect  output  into  a  single  package. 
Output  buffer  and  some  status  variables  will  be  protected  within 
the  body  of  this  package. 


package  FORMATTER  is 
procedure  BREAK; 
procedure  SPACE  (N  ;  NATURAL); 

—  Space  down  N  lines  or  to  end  of  page, 
procedure  PUTLINE  (LINE  :  STRING); 

—  Used  in  no-fill  mode 
procedure  PUTWORD  (WORD  s  STRING); 

—  Used  in  fill  mode 
end  FORMATTER; 
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Use  a  package  to  hold  values  used  in  several  places 
(like  a  COMMON  block)  . 

package  VALUES  is 

PILL  :  BOOLEAN  :»  TRUE; 
subtype  VALUE_RANGE  is 

INTEGER  range  0  ..  INTEGER' LAST; 

LINE_S PACING  :  VALUE_RANGE  :=  1; 

INDENT_VA LUE,  TEMP_INDENT,  CENTER_COUNT  : 

VALUE_RANGE  :=  0; 

RIGHT_MARGIN  j  VALUE_RANGE  :=  60; 

PAGE_LENGTH  :  VALUE_RANGE  :*  66; 
end  VALUES; 


i: 

i: 

t 
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Implementation  of  FORMAT 

with  INPUT_HANDLER,  VALUES,  FORMATTER; 
use  INPUT_HANDLER,  FORMATTER; 
procedure  FORMAT  is 
—  main  program 

procedure  COMMAND  is 

—  on  following  slide 
procedure  TEXT  is 

—  after  COMMAND 

begin 

—  Initialization  done  in  declarations 
while  READ_LINE()  loop 
if  IS_COMMAND{)  then 
COMMAND; 
el  se 

TEXT; 
end  if; 
end  loop; 

—  Termination 
BREAK; 

SPACE (VALUES. PAGE_LENGTH) ;  —  skip  to  end  of  page 
end  FORMAT; 
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Within  the  procedure  COMMAND,  we  will  be  changing  some  of  the 
variables  in  VALUES.  The  nature  of  these  changes  will  depend  on 
the  presence  or  absence  of  a  sign  on  the  parameter.  Also, 
parameters  themselves  are  optional.  The  following  procedure  will 
be  used  to  uniformly  handle  the  defaults  and  signs  and  with  some 
appropriate  checking. 


procedure  SET  (VAR  :  in  out  VALUE_RANGE;  —  one  of  the  variables 
VAL  :  VALUE_RANGE ;  —  from  the  command  line 
SIGN  :  SIGN_TYPE ;  —  from  the  command  line 
DEFAULT  :  VALUE_RANGE  :=  0; 

MIN  :  VALUE  RANGE  :=  0;  —  used  for  checking 


MAX  :  VALUE  RANGE  :=  INTEGER ' LAST)  is 


begin 


case  SIGN  is 

when  NO_PARAM  =>  VAR  :=  DEFAULT; 
when  PLUS  =>  VAR  :=  VAR  +  VAL; 
when  MINUS  *>  VAR  :=  VAR  -  VAL; 
when  NONE  =>  VAR  :=  VAL; 
end  case; 

—  Check  for  illegal  values 
if  VAR  >  MAX  then 
VAR  :*  MAX; 
el  si f  VAR  <  MIN  then 
VAR  :=  MIN; 
end  if; 
end  SET; 
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Implementation  of  COMMAND 
(within  FORMAT) 


with  INPUT_HANDLER,  VALUES,  FORMATTER; 
use  INPUT_HANDLER,  FORMATTER; 
procedure  FORMAT  is 


procedure  COMMAND  is 

subtype  VALUE  RANGE  is  VALUES. VALUE  RANGE; 

SIGN  :  SIGN_TYPE; 

VAL  :  VALUE  RANGE; 

SPACE  COUNT”:  INTEGER  :=  0; 
procedure  SET 
•  •  • 

end  SET; 

begin  —  body  of  COMMAND 
GET_VALUE  (SIGN,  VAL) ; 
case  COMMAND_TYPE()  is 
when  BP  =>  BREAK; 

SPACE  (VALUES. PAGE  LENGTH); 
when  BR  =>  BREAK; 
when  CE  =>  BREAK; 

SET  (VALUES. CENTER  COUNT,  VAL,  SIGN,  1); 

—  note  use  of  defaults 
when  FI  =>  BREAK; 

VALUES. FILL  :=  TRUE; 

when  IND=>  SET  (VALUES . INDENT_VALUE,  VAL,  SIGN); 

VALUES. TEMP_INDENT  :=  VALUES . INDENT_VALUE ; 
when  LS  =>  SET  (VALUES7LINE_SPACING,  VAL,  SIGN,  1,  1); 
when  NF  =>  VALUES. FILL  :=  FALSE; 

when  PL  =  >  SET  (VALUES. PAGE_LENGTH,  VAL,  SIGN,  66,  1); 
when  RM  =>  SET  (VALUES. RIGHT_MARGIN,  VAL,  SIGN,  60,  1); 
when  SP  =>  BREAK; 

--  use  SET  to  handle  the  sign  and  default 
SET  (SPACE_COUNT,  VAL,  SIGN,  1); 

SPACE  (SPACE_COUNT)  ; 
when  TI  =>  BREAK; 

SET  (VALUES. TEMP  INDENT,  VAL,  SIGN) ; 
when  UNKNOWN  =>  null;  —  ignore 
end  case; 
end  COMMAND; 


end  FORMAT; 
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w  Implementation  of  TEXT 
(within  FORMAT) 

with  INPUT_HANDLER,  VALUES,  FORMATTER; 
use  INPUT_HANDLER,  FORMATTER; 
procedure  FORMAT  is 
•  •  • 

procedure  TEXT  is 

WORD  :  WORD_STRING; 

LENGTH  :  INTEGER; 
beg  in 

PROCESS_B LANKS ; 

if  VALUES. CENTER_COUNT  >  0  then 
CENTER; 

PUTLINE  (LINEO); 

VALUES. CENTER_COUNT  ;=  VALUES . CENTER_COUNT  -  1; 
el  si f  BLANK_LINE ( )  or  not  VALUES. FILL  then 
PUTLINE (LINE ( ) ) ; 

else  —  handle  one  word  at  a  time 
loop 

NEXT_WORD  (WORD,  LENGTH) ; 
exit  when  LENGTH  =  0; 

PUTWORD  (WORD(l. .LENGTH) ) ; 
end  loop; 
end  i f ; 
end  TEXT; 

•  •  * 

end  FORMAT; 


CSI 


Outline  of  INPUT  HANDLER 


package  body  INPUT_HANDLER  is 

MAX_LINE_LENGTH  :  constant  INTEGER  :=  150; 

BUFFER  :  STRING  ( 1. .MAX_LINE_LENGTH) ; 

—  holds  current  input  line 

LENGTH,  CURRENT  s  range  0. .MAX_LINE_LENGTH ; 

—  LENGTH  is  length  of  current  input  line 
—  CURRENT  points  into  BUFFER  when  it  is  being 

—  used  word-by-word  in  fill  mode. 

function  READ_LINE  return  BOOLEAN  is 
•  •  • 

end'  READ_LIN£; 

function  IS_COMMAND  return  BOOLEAN  is 
•  •  • 

end  IS  COMMAND; 

function  COMMAND_TYPE  return  COMMANDS  is 
•  •  • 

end  COMMAND_TYPE ; 

procedure  GET_VALUE  (SIGN  :  out  SIGN_TYPE ; 

VALUE  :  out  INTEGER)  is 

•  •  • 

end  GET_VALUE; 

procedure  PROCESS_BLANKS  is 
•  •  • 

end  PROCESS_BLANKS; 

procedure  CENTER  is 

•  •  • 

end  CENTER; 

function  BLANK_L INE  return  BOOLEAN  is 
•  •  • 

end  B LAN K_L INE; 

procedure  NEXT_WORD  (WORD  :  out  WORD_STRING ; 

LENGTH  :  out  INTEGER)  is 

•  •  • 

end  NEXT_WORD; 

function  LINE  return  STRING  is 
•  •  • 

end  LINE;  ‘  ’ 

end  INPUT  HANDLER; 


i 
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Design  of  GET  VALUE 


procedure  GET_VALUE  (SIGN  :  cut  SIGN_TYPE; 

VALUE  :  out  INTEGER)  is 

beg  in 

skip  over  command 
skip  intervening  blanks 
set  SIGN 

do  conversion  on  characters  to  get  VALUE 

end 
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Implementation  of  GET_VALUE 
(within  INPUT  HANDLER) 


package  body  INPUT_HANDLER  is 

MAX_LINE  LENGTH  :  constant  INTEGER  :=  150; 

BUFFER  : “STRING  ( 1 . . MAX_LINE_LENGTH) ; 

—  holds  current  input  line 

LENGTH,  CURRENT  :  range  0. .MAX_LINE_LENGTH ; 

—  LENGTH  is  length  of  current  input  line 
—  CURRENT  points  into  BUFFER  when  it  is  being 

—  used  word-by-word  in  fill  mode. 

•  •  • 

procedure  GET_VALUE  (SIGN  :  out  SIGN_T¥PE; 

VALUE  s  out  INTEGER)  is 
COL  :  range  1. .MAX_LINE_LENGTH; 

function  CONVERT  (INDEX  :  INTEGER)  return  INTEGER  is 

—  converts  a  string  of  digits  starting  at  INDEX  in 
—  BUFFER  to  an  integer. 

begin 

—  Use  the  same  technique  as  in  RECORD  HANDLER. 

•  •  • 

end  CONVERT; 
beg  in 

—  skip  over  command,  three  characters  long 

—  (could  be  generalized  to  handle  arbitrary  length 

by  looking  for  a  special  command  syntax) 

COL  :=  4; 

SKIP_BLANKS (COL) ;  —  skips  blanks  and  tabs 

if  COL  >  LENGTH  then 

—  nothing  left  on  line 
SIGN  :=  N0_PARAM; 

VALUE  :=  0;  —  should  never  be  used,  in  this  case 
else 

case  BUFFER ( COL)  is 

when  '+’  =>  SIGN  :=  PLUS; 

COL  :=  COL  +  1; 
when  =>  SIGN  :=  MINUS; 

COL  ;=  COL  +  1; 
others  =>  SIGN  :=  NONE; 
end  case; 

VALUE  :=  CONVERT  (COL); 

--  CONVERT  will  convert  a  string  of  digits 
—  starting  at  position  COL  to  an  INTEGER 
end  if; 

end  GET_VALUE; 
end  INPUT  HANDLER; 
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Implementation  of  INPUT_HANDLER 


with  VALUES,  TEXT  10,  FORMATTER; 

use  VALUES,  TEXT_I0,  FORMATTER;  —  FORMATTER  needed  for  call  to  BREAK 
package  body  INPUT_HANDLER  is 

MAX_LINE_LENGTH  :  constant  INTEGER  :=  150; 

BUFFER  :  STRING  (1..MAX  LINE_LENGTH) ; 

LENGTH,  CURRENT  :  range"~0.  .MAX_LINE_LENGTH; 

function  READ_LINE  return  BOOLEAN  is 
beg  in 

if  END_OF_FILE(STANDARD_INPUT)  then 
return  FALSE; 
else 

LENGTH  :*  0; 

while  not  END_OF_LINE  loop 
LENGTH  : —  LENGTH  +  1; 

GET (BUFFER (LENGTH) ) ; 
end  loop; 

CURRENT  :=  1;  —  used  by  NEXT_WORD 
return  TRUE; 
end  if; 

end  READ  LINE; 


function  IS_COMMAND  return  BOOLEAN  is 
begin 

return  BUFFER ( 1 )  * 
end  IS  COMMAND; 


function  COMMAND  TYPE  return  COMMANDS  is 
FIRST  !  CHARACTER  :=  BUFFER(2) ; 
SECOND  :  CHARACTER  :=  BUFFER(3) ; 

C  :  COMMANDS; 
begin 

C  :=  UNKNOWN; 


case  FIRST 
when  'b' 

is 

=> 

if 

SECOND 

_ 

•p' 

then 

C 

s 

BP; 

when 

'  c' 

=> 

el  si f  SECOND 
if  SECOND  = 

*  e' 

' r'  then 
then  C 

c 

s 

:  =  BR ;  end 
CE;  end  if; 

when 

'  f* 

=> 

if 

SECOND 

as 

•  i  1 

then 

C 

s 

FI ;  end 

if  ; 

when 

•  i' 

=> 

if 

SECOND 

* 

'  n' 

then 

C 

s 

IND;  end 

if 

when 

•  1  • 

=> 

if 

SECOND 

= 

•  s' 

then 

C 

= 

LS ;  end 

if  ; 

when 

•n' 

=> 

if 

SECOND 

= 

’f’ 

then 

C 

3 E 

NF;  end 

if; 

when 

'  P' 

=  > 

if 

SECOND 

= 

•1' 

then 

c 

= 

PL;  end 

if  ; 

when 

•r' 

=  > 

if 

SECOND 

s 

'm* 

then 

c 

s 

RM;  end 

if; 

when 

•  s' 

=> 

if 

SECOND 

= 

'P' 

then 

c 

ss 

SP;  end 

if  ; 

when 

’  t' 

=> 

if 

SECOND 

= 

’i' 

then 

c 

= 

TI;  end 

if; 

when 

others 

= > 

nul  1 ; 

end  case; 
return  C; 
end  COMMAND  TYPE; 
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Implementation  of  INPUT_HANDLER 
(Continued) 


procedure  SKI P_B LAN KS  (I  :  in  out  INTEGER)  is 
—  Advances  I  until  BUFFER(i)  is  not  a  blank  or  tab. 
•  •  • 

end  SKIP  BLANKS; 


procedure  GET_VALUE  (SIGN  :  out  SIGN_TYPE; 

VALUE  :  out  INTEGER)  is 
COL  :  range  1..MAX  LINE_LENGTH; 


function  CONVERT  (INDEX  :  INTEGER)  return  INTEGER  is 
—  converts  a  string  of  digits  starting  at  INDEX  in 
—  BUFFER  to  an  integer, 
begin 

—  Use  the  same  technique  as  in  RECORD_HANDLER. 

—  Return  0  if  no  digits  encountered. 

•  •  • 

end  CONVERT; 


beg  in 

—  skip  over  command,  three  characters  long 

—  (could  be  generalized  to  handle  arbitrary  length 

—  by  looking  for  a  special  command  syntax) 

COL  s=  4; 

SKIP_BLANKS (COL) ;  —  skips  blanks  and  tabs 

if  COL  >  LENGTH  then 

—  nothing  left  on  line 
SIGN  :=  NO_PARAM; 

VALUE  :«  0;  —  should  never  be  used,  in  this  case 
else 

case  BUFFER (COL)  is 

when  '+'  =>  SIGN  :»  PLUS; 

COL  :=  COL  +  1; 
when  ->  SIGN  :=  MINUS; 

COL  :=  COL  +  1; 
others  *>  SIGN  :=  NONE; 

VALUE  ;*  'CONVERT  (COL); 

—  CONVERT  will  convert  a  string  of  digits 
—  starting  at  position  COL  to  an  INTEGER 
end  if; 

end  GET  VALUE; 


*  ' 

!. 

r 
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Implementation  of  INPUT_HANDLER 
(Continued) 


procedure  PROCESS_B LANKS  is 

—  Remove  leading  blanks,  incrementing  temporary  indent 

—  counter  appropriately. 

NUM_B LANKS  :  range  O..MAX_LINE  LENGTH; 
begin 

if  BUFFER(l)  /=  '  '  then 

return;  —  This  procedure  is  not  relevant, 
end  if; 

BREAK;  —  .ti  causes  a  break 
—  Find  first  non-blank; 

NUM_B LANKS  :=  1; 

while  NUM  BLANKS  <  LENGTH 

and~then  BUFFER (NUM  B LANKS+1 )  =  *  •  loop 
NUM_B LANKS  :  =  NUM_B LANKS  +  1; 
end  loop; 

—  Process  result 
if  NUM_B LANKS  *  LENGTH  then 

LENGTH  s*  0;  —  indication  of  a  blank  line 

else 

TEMP_INDENT  :«  NUM_B LANKS  +  INDENT_VALUE; 

BUFFER ( 1. .LENGTH-NUM_B LANKS) 

:=  BUFFER (NUM_B LANKS+1. .LENGTH) ; 

LENGTH  j*  LENGTH  -  NUM_B LANKS; 
end  if; 

end  PROCESS  BLANKS; 


procedure  CENTER  is 

—  Centering  is  accomplished  by  manipulation  of  TEMP_INDENT. 
NEW- VALUE  :  INTEGER; 
begin 

NEW_VALUE  :*  (RIGHT  MARGIN  +  TEMP_INDENT  -  LENGTH)  /  2; 
if  NEW  VALUE  >  0  THEN 

TEMP_INDENT  s*  NEW_VALUE ; 
end  if; 
end  CENTER; 


function  BLANK  LINE  return  BOOLEAN  is 
beg  in  ~ 

return  LENGTH  =  0; 
end  BLANK  LINE; 


function  LINE  return  STRING  is 
beg  in 

return  BUFFER ( 1. . LENGTH)  ; 
end  LINE; 
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Implementation  of  INPUT_HANDLER 
(Continued) 


procedure  NEXT  WORD  (WORD  :  out  W ORD_STR I NG ; 

LENGTH  :  out  INTEGER)  is 

—  Uses  the  variable  CURRENT.  LENGTH  will  tell  how  many 

—  characters  in  WORD  are  significant.  Any  string  of 

—  non-blank  characters  is  a  'word' . 

end* NEXT  WORD; 


end  INPUT  HANDLER 


Outline  of  FORMATTER 


package  body  FORMATTER  is 

MAX  LINE_LENGTH  :  constant  INTEGER  :«  132; 

MARGIN  :  constant  INTEGER  :■  4; 

BUFFER  :  STRING  (l..MAX_LINE  LENGTH); 

—  Current  output  line 

OUT_PTR,  OUT  WORDS,  LINE  NUM  :  VALUE  RANGE  :«  0; 

--  OUT_PTE  points  to  Tast  character  in  BUFFER 
—  OUT~WORDS  is  the  number  of  words  on  this  line 
—  LINE_NUM  is  the  current  line  number 

procedure  BREAK  is 
•  •  • 

end  BREAK; 

procedure  SPACE  (N  :  NATURAL)  is 
•  •  • 

end  SPACE ; 

procedure  PUTLINE  (LINE  :  STRING)  is 
•  •  • 

end  PUTLINE; 

procedure  PUTWORD  (WORD  s  STRING)  is 
•  •  • 

end  PUTWORD; 
end  FORMATTER; 
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Implementation  of  FORMATTER 


with  VALUES,  TEXT_IO; 
use  VALUES,  TEXT  10; 
package  body  FORMATTER  is 

MAX_LINE  LENGTH  :  constant  INTEGER  :=  132; 

BUFFER  :  STRING  ( 1. .MAX_LINE_LENGTH) ; 

OUT_PTR,  OUT_WORDS,  LINE  NUM  s  VALUE  RANGE  :«  0; 
MARGIN  :  constant  INTEGEff  4; 

BLANK  :  constant  CHARACTER  :=  •  •; 

BOTTOM  :  constant  INTEGER  :«  PAGE_LENGTH  -  MARGIN; 

function  MIN  (I,  J  :  INTEGER)  return  INTEGER  is 
beg  in 

if  I  <  J  then 
return  I; 
else 

return  J; 
end  if; 
end  MIN; 


procedure  PUTLINE  (LINE  :  STRING)  is 
—  Send  LINE  to  the  output  file 

BLANKS  :  constant  STRING  :*  (1. ,MAX_LINE_LENGTH  *>  BLANK); 
beg  in 

if  LINE  NUM  «  0  or  LINE_NUM  >  BOTTOM  then 
—  start  a  new  page 

NEW_LINE  (MARGIN);  —  puts  out  blank  lines 
LINE_NUM  :=  MARGIN  +  1; 
end  if; 

—  put  out  leading  blanks 
PUT  (BLANKS ( 1. . TEMP_INDENT)  ) ; 

TEMP_INDENT  :«  INDE?JT_VALUE ; 

—  write  out  the  string  LINE 
PUT  (LINE); 

—  handle  line  spacing 

NEW_LINE  (MIN  (LINE_SPACING,  BOTTOM-LINE  NUM+1) ) ; 

LINE  NUM  :=  LINE_NUM  +  LINE_S PACING ; 

—  cKeck  for  end  of  page 
if  LINE  NUM  >  BOTTOM  then 

NEW  TINE  (MARGIN); 

—  TlNE_NUM  is  purposely  not  changed  here 
end  if; 
end  PUTLINE; 
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Implementation  of  FORMATTER 
(Continued) 


procedure  SPACE  (N  :  NATURAL)  is 
—  skip  N  lines  or  to  bottom  of  page 
beg  i  n 

if  LINE_NUM  >  BOTTOM  then 

—  spacing  has  no  effect  in  this  case 
return; 
end  if; 

if  LINE_NUM  «  0  then 
NEW  LINE  (MARGIN); 

LINE_NUM  :=  MARGIN  +  1; 
end  if; 

NEW_LINE  (MIN  (N,  BOTTOM-LINE  NUM+1)); 
LINE  NUM  :«  LINE_NUM  +  N; 

—  cFTeck  for  end  of  page 
if  LINE_NUM  >  BOTTOM  then 
NEW_LINE  (MARGIN); 
end  if; 
end  SPACE; 


procedure  BREAK  is 
—  end  current  filled  line 
beg  in 

if  OUT_PTR  >  0  then 

PUTLINE (BUFFER (1. .OUT  PTR) ) ; 
OUT_PTR  :«  0; 

OUT_WORDS  j-  0; 
end  i f ; 
end  BREAK; 


procedure  PUTWORD  (WORD  :  STRING)  is 
•  •  • 

end  PUTWORD; 


end  FORMATTER; 


Design  of  PU7YI0RD 


procedure  PUTWORD 


begin 

Compute  current  line  length  +  word  length 
if  new  length  >  allowed  line  length  then 

—  Addition  of  blanks  necessary  to  right-justify 
Spread  out  words  in  buffer  to  fill  line 
Break  —  to  flush  out  the  line 
end  if 

Copy  word  to  output  buffer 
Adjust  state  variables 
end  PUTWORD; 
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Design  of  SPREAD 


procedure  SPREAD 

—  the  number  of  blanks  to  add  will  be  passed  as  a  parameter 


begin 

Switch  direction  flag 

—  add  blanks  from  opposite  ends  on  alternate  lines 
Compute  number  of  holes  —  spaces  between  words 
loop  from  end  to  beginning  of  words  in  buffer 
copy  a  character  to  next  available  slot 
i f  character  is  a  blank  then 

insert  appropriate  number  of  extra  blanks 
—  based  on  number  of  holes 
end  if 
end  loop 
end  SPREAD 
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Implementation  of  PU1W0RD 
(within  FORMATTER) 


package  body  FORMATTER  is 

MAX_LINE_LENGTH  :  constant  INTEGER  :■  132; 

MARGIN  s  constant  INTEGER  :=  4; 

BUFFER  :  STRING  ( 1 . .MAX_LINF_LENGTH) ; 

—  Current  output  line 

OUT_PTR,  OUT  WORDS,  LINE  NUM  i  VALUE_RANGE  :«  0; 

--  0UT_PTl?  points  to  Tast  character  in  BUFFER 
—  OUT_WORDS  is  the  number  of  words  on  this  line 
—  LINE  NUM  is  the  current  line  number 


procedure  PUTWORD  (WORD  :  STRING)  is 
LAST,  LINE_SIZE  s  VALUE_RANGE; 
begin 

LINE  SIZE  :*  RIGHT  MARGIN  -  TEMP  INDENT; 

if  oUt  ptr  +  word 'Length  >  line_3ize  then 

—  Addition  of  blanks  necessary  to  right- justify 
SPREAD  (LINE  SIZE  -  OUT  PTR  +  1); 

—  "+  1"  Because  BUFFER (0UT_PTR)  is  a  blank 
if  OUT_WORDS  >  1  then 

OUT_PTR  LINE_SIZE;  —  the  effect  of  SPREAD 
end  i f ; 

BREAK; 
end  if; 

—  Copy  WORD  and  a  blank  to  output  buffer 
LAST  :=  OUT  PTR  +  WORD' LENGTH  +  1; 

BUFFER  (OUT_PTR+l.  .LAST)  :*  WORDS.  BLANK; 

—  Adjust  state  variables 
OUT  PTR  LAST; 

OUT  WORDS  :*  OUT_WORDS  +  1; 
end  PUTWORD; 


end  FORMATTER; 
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Implementation  of  SPREAD 
(within  PUTWORD) 


package  body  FORMATTER  is 

MAX_LINE_LENGTH  s  constant  INTEGER  :*  132; 

MARGIN  :  constant  INTEGER  :=  4; 

BUFFER  :  STRING  (1 . .MAX_LINE_LENGTH) ; 

—  Current  output  line 

OUT_PTR,  OUT  WORDS,  LINE  NUM  :  VALUE  RANGE  :*  0; 

--  OUT_PTR  points  to  Tast  character  in  BUFFER 
—  OUT_WORDS  is  the  number  of  words  on  this  line 
—  LINE_NUM  is  the  current  line  number 

•  •  • 

ADD_F ROM_R I GHT  :  BOOLEAN  :=  TRUE; 

must  be  at  the  package  body  level;  used  by  SPREAD  to 
—  insert  blanks  at  opposite  ends  of  alternate  lines 

procedure  PUTWORD  (WORD  :  STRING)  is 
•  •  • 

procedure  SPREAD  (NUM  BLANKS  ;  VALUE_RANGE)  is 
I,  J,  NUM_HOLES,  ADD_COUNT  :  VALUE_RANGE ; 

NUM_EXTRA  :  VALUE_RANGE  :*  NUM_BLANKS; 
begin  ” 

if  OUTWORDS  <*  1  then 

return;  —  nowhere  to  put  blanks 
end  if; 

ADD_FROM_RIGHT  :=  not  ADD_FROM_RIGHT ; 

—  add  blanks  from  opposite  ends  on  alternate  lines 
NUM_HOLES  :=  OUT_WORDS  -  1; 

I  :=  OUT_PTR  -  1;  —  points  to  last  non-blank  char 
J  :=  I  +~NUM  EXTRA; 
while  I  <  J  loop 

BUFFER (J)  :*  BUFFER(I) ; 
if  BUFFER (J)  =  BLANK  then 
if  ADD  FROM_R IGHT  then 

ADD~COUNT  :=  (NUM_E XTRA  -  1)  /  NUM_HOLES  +  1; 
else  ~ 

ADD__COUNT  :=  NUM_E  XTRA  /  NUM__H0LES; 
end  iff 

NUM_EXTRA  :*  NUM_E XTRA  -  ADD_COUNT; 

NUM_HOLES  :»  NUM  HOLES  -  1; 
for  K  in  1 . .ADD  COUNT  loop 
J  :»  J  -  1;  " 

BUFFER  (J)  :*  BLANK; 
end  loop; 
end  if; 
end  loop; 
end  SPREAD; 

•  •  • 

end  PUTWORD; 

•  •  • 

end  FORMATTER; 
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CASE  STUDY  II 

TELEPHONE  SWITCHING  SIMULATION 


z  r 


System  Block  Diagram 


CSII 


Network  Operation 


Each  line  handler  monitors  its  associated  telephone  lines  for 
such  events  as  digits  being  transmitted  and  the  receiver  being 
lifted  from  or  returned  to  the  hook.  When  these  events  occur, 
the  line  handler  notifies  the  call  processor.  Upon  command  from 
the  call  processor,  it  also  controls  ringing.  The  line  hanldlers 
are  used  (rather  than  a  single  central  processor)  in  order  to 
distribute  the  real-time  demands  of  line  monitoring. 

The  call  processor  is  driven  by  messages  from  the  line  handlers 
concerning  line  events.  It  translates  phone  numbers  to  physical 
line  addresses  and  controls  the  connection  and  disconnection  of 
circuits . 

This  simulation  will  only  be  concerned  with  the  transmission  of 
control  signals  among  the  various  components  of  the  network  and 
the  interpretaion  of  these  signals.  Data  could  be  collected  to 
determine  the  adequacy  of  the  components  and  the  architecture  of 
the  network  to  handle  various  traffic  loads. 
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Program  Task  Structure 


The  following  tasks  will  exist  throughout  the  execution  of  the 
simulatiion : 

-  The  CALL  PROCESSOR  will  be  represented  by  a  task. 

-  Each  LINE  HANDLER  will  be  represented  by  an  identical  task. 

-  Each  telephone  will  be  represented  by  a  PHONE  task. 

-  Calls  will  be  generated  by  a  DRIVER  task. 


Each  call  will  be  represented  by  a  dynamically  allocated  CALL 
task,  which  will  communicate  with  the  PHONE  tasks  involved.  Such 
tasks  will  terminate  when  the  calls  they  represent  are  completed. 


The  control  signals  flowing  through  the  network  will  be 
represented  by  messages  passed  among  these  tasks. 
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MESSAGE 


A  single  message  type  will  be  useful,  so  that  all  message  handl¬ 
ing  can  be  done  uniformly.  We  will  use  the  following 
declarations  to  define  such  a  message  type. 


type  MSGJTYPE  is  (NOISE,  DIGIT,  HOOK,  STATUS,  DETAIL); 

type  STATUSJTYPE  is  (RINGING,  BUSY,  DIALTONE,  CONNECTED, 

DISCONNECTED,  COMPLETED,  NOANSWER,  PHONEFREE,  NOTFREE) ; 

type  MESSAGE  (KIND  :  MSGJTYPE)  is 
record  *” 

SENDER  :  INTEGER;  —  to  identify  source 
LINE_NUM  s  INTEGER;  —  sometimes  needed 
case  KIND  is 

when  NOISE  ->  RING  :  BOOLEAN; 

—  start  phone  ringing  if  TRUE 

—  stop  if  FALSE 
when  DIGIT  =>  DIGIT  i  INTEGER; 

when  HOOK  =>  HOOK  STATE  :  (ON,  OFF); 

when  STATUS  *>  STXTE  :  STATUSJTYPE; 

when  DETAIL  =>  LENGTH  :  INTEGER;  —  length  of  call 

FROM  :  INTEGER;  —  calling  line  number 
TO  s  INTEGER;  —  number  being  called 
HANGUP  :  INTEGER;  —  which  one  hangs  up 

end  case; 
end  MESSAGE; 
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Communication  between  Tasks 


We  want  to  send  messages  between  tasks  asynchronously  so  that, 
for  example,  a  LIME  HANDLER  need  not  wait  until  the  CALL  PROCES¬ 
SOR  has  actually  processed  one  of  its  messages  before  it  can 
receive  a  message  from  a  PHONE.  We  will  thus  need  tasks  to  han¬ 
dle  the  mechanics  of  message  buffering.  Each  task  will  have  a 
corresponding  message  buffer  task  to  handle  its  incoming  com¬ 
munication. 


task  type  MESSAGE_B UFFER  is 

entry  SEND  (M  7  in  MESSAGE); 

—  called  by  other  tasks  to  send  a  message  to  the 

—  corresponding  task 

entry  RECEIVE  (M  :  out  MESSAGE); 

—  called  by  the  corresponding  task  to  accept  messages 
end  MESSAGE  BUFFER; 


Since  MESSAGE  is  a  globally  declared  record  type  with  variants  to 
represent  all  of  the  different  kinds  of  messages  which  might  be 
used  by  any  of  the  tasks,  we  need  only  write  one  message  buffer¬ 
ing  task. 
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Simulation  Primitives 


To  implement  a  simulation  capability,  we  need  routines  to 
maintain  an  event  list,  to  keep  track  of  a  simulation  time  and  to 
allow  tasks  to  be  scheduled  for  execution.  In  this  particular 
problem,  the  only  scheduling  primitive  needed  by  the  tasks 
representing  the  various  system  components  is  hold ,  which  allows 
a  given  task  to  suspend  its  execution  for  a  fixed  amount  of 
simulation  time. 

The  simulation  routines  will  be  implemented  as  a  package.  Any 
tasks  wishing  to  use  hold  must  have  previously  been  assigned  a 
task  identifier  by  the  simulation  package.  A  procedure  will  be 
available  in  the  package  for  this  package. 


package  SIMULATION  is 

type  TASK_ID  is  private; 
procedure“GET_ID  (ID  :  out  TASK_ID) ; 

—  used  to  ask  for  a  task  identifier 
procedure  RETURN_ID  (ID  :  in  TASK_ID) ; 

—  used  by  dynamic  process  when  they  terminate 
procedure  HOLD  (ID  :  in  TASK  ID;  TIME  :  in  INTEGER); 

—  TIME  is  milliseconds  oT  simulation  time 
procedure  RECEI VE_MESSAGE  (BUFFER  :  in  MESSAGE  BUFFER; 

M  :  out  MESSAGE);  ” 

—  called  by  a  task  when  it  wants  to  remove  a 

—  message  from  its  buffer 
private 

type  TASK_ID  is  new  INTEGER; 
end  SIMULATION; 


The  RECEIVE_MESSAGE  procedure  is  necessary  in  order  to  allow  the 
simulation  package  to  know  about  those  tasks  which  are  suspended 
waiting  for  message,  as  well  as  those  suspended  by  calls  to  hold. 


Main  Program  Structure 


procedure  SWITCH  <NUM_LINES  :  INTEGER;  —  not  greater  than  8999 

RUN  LENGTH  :  INTEGER)  —  simulation  time 


is 


—  message  declarations  (as  on  earlier  slide)  go  here 


task  type  MESSAGE_BUFFER  is 

entry  SEND  (M  T  in  MESSAGE); 
entry  RECEIVE  (M  :  out  MESSAGE); 
end  MESSAGE_BUFFER; 

package  SIMULATION  is 

.  —  as  on  previous  slide 

end  SIMULATION 


task  CALL_PROCESSOR; 

task  type  LINE_HANDLER  is 

entry  STARTUP  (INDEX  :  INTEGER); 
end  LINE_HANDLER; 

task  type  PHONE  is 

entry  STARTUP  (INDEX  :  INTEGER); 
end  PHONE; 

task  type  CALL;  —  these  are  allocated  dynamically 
task  DRIVER;  —  generates  calls 
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Main  Program  (continued) 


—  declarations  of  constants  and  variables 

MAX_LINE_NUM  :  constant  INTEGER  NUM_LINES  -  1; 

MAX_HANDLER  :  constant  INTEGER  :■  MAX_LINE_NUM  /  10  +  1; 

—  maximum  of  ten  lines  per  handle? 

—  Phone  numbers  will  be  represented  by  four  digits. 

—  The  first  three  digits  minus  100  will  be  the  handler  number. 

—  The  fourth  digit  will  be  the  line  number  belonging  to 

—  that  handler.  The  smallest  phone  number  is  1000, 

—  corresponding  to  line  0  of  handler  000. 

HANDLERS  :  array  (0. . MAX_HANDLER)  of  LINE_HANDLER; 

HANDLER__B UPPERS  :  array(0.  .MAX^HANDLER)  o?  MESSAGE_BUFFER ; 

PHONES  :  array  (0..MAX  LINE  NUM)  of  PHONE; 

PHONE_BUFFERS  :  array(Z).  .MAX_LINE_NUM)  of  MESSAGE_BUFFER; 

PROCESSOR  BUFFER  :  MESSAGE_BUFFER ; 

DRIVER_BU?TER  s  MESSAGE_B  UFFER ; 

use  SIMULATION;  —  needed  in  main  program  body 

MAIN_TASK  s  TASK_ID; 

—  Bodies  of  tasks  and  the  SIMULATION  package  would  go  here 
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Main  Program  (continued) 


begin  —  body  of  SWITCH 

—  send  buffer  indices  to  line  handler  and  call  receiver  tasks 
for  I  in  0. .MAX_LINE  NUM  loop 

PHONES (I) .STARTUP” (INDEX  *>  I); 
end  loop; 

for  I  in  0. .MAX_HANDLER  loop 

HANDLERS (I) .STARTUP  (INDEX  «>  I); 
end  loop; 

—  wait  for  RUN  LENGTH  simultation  time  to  elapse 
GET_ID  (MAIN_TA5K) ; 

HOLD  (MAIN_TASK,  RUN_LENGTH) ; 

—  Produce  statistics  and  terminate  all  tasks 


end  SWITCH; 
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Body  of  MESSAGE  HANDLER 


task  body  MESSAGEJiANDLER  is 

—  We  will  assume  the  availability  of  a  generic  package 

—  called  LINKED  LIST,  which  is  much  like  SORTED_LIST 

—  except  that  tKere  are  no  priorities  involved  and 

—  insert  puts  the  new  item  at  the  end  of  the  list. 

package  MESSAGE  LIST  is  new  LINKED_LIST(MESSAGE) ; 
use  MESSAGE_LIST; 

MESSAGES  :  LIST; 

COUNT  :  INTEGER  :«  0; 

beg  in 

CREATE  (MESSAGES) ; 

loop  —  no  exit  from  this  loop  except  by  termination 
select 

when  COUNT  >  0  *> 

accept  RECEIVE  (M  :  out  MESSAGE)  DO 
NEXT  ENTRY  (MESSAGES,  M) ; 

COUNT  j=  COUNT  -  1? 
end  RECEIVE; 

or  accept  SEND  (M  :  in  MESSAGE)  do 
INSERT  (MESSAGES,  M) ; 

COUNT  :*  COUNT  +  1; 
end  SEND; 

or  when  COUNT  =  0  =>  terminate; 
end  select; 
end  loop; 

end  MESSAGE  BUFFER; 


Body  of  SIMULATION 


package  body  SIMULATION  is 

—  Since  the  event  list  is  a  shared  data  structure,  a  task  will  be 

—  used  to  synchronize  access  to  it. 
task  LIST  HANDLER  is 

entry  *DD  ENTRY  (ID  :  TASK  ID;  TIME  :  INTEGER); 
entry  ADVANCE  TIME;  ~ 

end  LIST_HANDLER7 

—  A  task  will  be  used  to  manage  task  ids,  again  because  of 

—  shared  data  structures; 
task  ID_MANAGER  is 

entry  GET_ID  (ID  :  out  TASK_ID)  ; 
entry  RETURN_ID  (ID  s  in  TASK  ID); 
end  ID_MANAGER; 

—  A  task  will  be  necessary  to  keep  count  of  the  number  of 

—  tasks  suspended,  in  order  to  know  when  to  advance  the 

—  simulation  time, 
task  COUNTER  is 

entry  INCREMENT; 
entry  DECREMENT; 
entry  INCREM ENT_TOTAL; 
entry  DECREMENTJTOTAL; 
end  COUNTER; 

—  A  task  type  is  introduced  to  implement  task  suspension, 
task  type  SIGNAL  is 

entry  SEND; 
entry  WAIT; 
end  SIGNAL; 

MAX_TASK_ID  :  constant  TASK_ID  :*  MAX_LINE_NUM  *  2; 

SIGNALS  :  array  ( 1 . . MAX_TASK_ID)  of  SIGNAL; 

—  one  for  each  task  which  could  be  suspended 

task  body  SIGNAL  is 
beg  in 
loop 

accept  SEND; 
accept  WAIT; 
end  loop; 
end  SIGNAL; 


SIMULATION  (continued) 


procedure  GET_ID  (ID  :  out  TASK  ID)  is 
beg  in 

I D_MANAGER . GET  ID  (ID); 

COUNTER. INCREMENT  TOTAL; 
end  GET_I De¬ 
procedure  RETURN_ID  (ID  ;  in  TASK_ID)  is 
beg  in 

ID_MANAGER.RETURN_ID  (ID); 

COUNTER . DECREMENT_TOTAL ; 
end  RETURN_I De¬ 
procedure  HOLD  (ID  :  TASK_ID;  TIME  :  INTEGER)  is 
beg  in 

LIST  HANDLER. ADD  ENTRY  (ID,  TIME); 

COUNTER. INCREMENT; 

SIGNALS(ID) .WAIT;  —  suspends  this  procedure  until 

—  ADVANCE  TIME  does  a  SIGNAL 

COUNTER. DECREMENT; 
end  HOLD; 

procedure  RECEI VE_MESSAGE  (BUFFER  :  in  MESSAGE_B UFFER; 

M  :  out  MESSAGE)  is" 

beg  in 

select 

BUFFER. RECEIVE  (M)  ; 

else  ; —  no  messages  currently  available 
COUNTER. INCREMENT; 

BUFFER. RECEIVE  (M); 

—  will  cause  suspension  until  a  massage  comes 
COUNTER. DECREMENT; 
end  select; 
end  RECEIVE  MESSAGE; 
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SIMULATION  (continued) 


task  body  LIST_HANDLER  is 

—  This  task  will  use  a  package  like  SORTED  LIST  to  implement 

—  an  event  list,  except  that  the  items  must"  be  sorted  in 

—  ascending  proirity  order. 

—  (The  "priorities"  are  event  times.) 

package  LISTJPACKAGE  is  new  ASCENDING  SORTED  LIST  (TASK  ID); 
use  LIST_PACfCAGE;  ~  ~ 

EVENT_LIST  :  LIST: 

ID  :  TASK_ID; 

SIMJTIME  :  INTEGER  :«  0;  —  simulation  time 

beg  in 

CREATE  (EVENT_LIST) ; 
loop 

select 

accept  ADD  ENTRY  (ID  :TASK_ID;  TIME  :  INTEGER)  do 
INSERT  lEVENT_LIST,  ID,  SIMJTIME+TIME) ; 
end  ADD_ENTRY; 
or  accept  ADVANCE  TIME; 

NEXT_ENTRY  ( EVENT_LIST,  ID,  SIMJTIME) ; 

SIGNALS  (ID)  .SEND;'"—  awakens  a  task  in  HOLD 
end  select; 
end  loop; 
end  LIST  HANDLER; 


task  body  ID_MANAGER  is 

NEXT  TASK_ID  :  INTEGER  :=  0; 

ID_S'ET  :  array  (1.  ,MAX_TASK_ID)  of  range  0. . MAX  JT  AS K_ID; 
begin 

for  I  in  1 . .MAX  TASK  ID-1  loop 
ID_SET ( I )  : =-I+l 
end  loop; 

ID  SET ( MAX  TASK_ID)  :*  0; 
loop 

select 

when  NEXT  TASK  ID  /=*  0 
accept  GET  ID  TlD  :  out  TASK_ID)  do 
ID  :«  NfXT  TASK_ID; 

NEXT_TASK  ID  :«  ID  SET (NEXT_TASK_ID) ; 
end  GET  ID;  ~ 

or  accept  RETURN  ID  (ID  :  in  TASK  ID)  do 
ID  SET (ID)  :«  NEXT  TASK_ID;~ 

NE^T  TASK  ID  :*  ID? 
end  RETURN_IT3; 
end  select; 
end  loop; 
end  ID  MANAGER; 


SIMULATION  (continued) 


task  body  COUNTER  is 

TOTAL_TASKS ,  SUS  PENDED_TAS  KS  :  INTEGER  :=  0; 
begin 
loop 

select 

accept  INCREM ENT_T0TAL  do 

TOTAL  TASKS  :=  TOTALJTASKS  +  1; 
end  INCRfMENTJTOTAL; 

or  accept  DECREMENT  TOTAL  do 

TOTAL  TASKS  TOTAL  TASKS  -  1; 
end  DECREmENTJTOTAL;  “ 

or  accept  INCREMENT  do 

SUSPENDED  TASKS  :=  SUSPENDED  TASKS  +  1; 
if  SUSPENDED  TASKS  >=  TOTAL  TASKS  then 
ADVANC  E_TTM  E ;  “ 

end  i f ; 

end  INCREMENT; 

or  accept  DECREMENT  do 

SUS PENDED_TASKS  :=  SUSPENDED  TASKS  -  1; 
end  DECREMENT;  “ 

or  terminate; 

end  select; 
end  loop; 
end  COUNTER; 

end  SIMULATION; 
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Body  of  LINE  HANDLER; 


The  following  task  body  provides  a  simple  example  of  the  use  of 
the  simulation  and  message  buffering  capabalities  by  a  task  which 
represents  one  of  the  simulation  objects, 
task  body  LINE_HANDLER  is 

M  :  MESSAGE; 

MY_NUMBER  :  INTEGER;  —  used  as  message  buffer  index 
ME“:  TASK_ID;  —  for  identification  to  SIMULATION  package 

HANDLING_TIME  :  constant  :=  50;  —  units  of  simulation  time 

use  SIMULATION; 

beg  in 

accept  STARTUP  (INDEX  :  INTEGER)  do 
MY_NUMBER  INDEX; 
end  STARTUP; 

GET_ID  (ME) ; 

loop  —  loops  forever,  simulating  a  line  handler 
RECEIVE_MESSAGE  (HANDLER_BUFFERS (MY_NUMBER) ,  M) ; 
case  M. KIND  is 

when  DIGIT  |  HOOK  => 

—  line  event;  pass  on  to  call  processor 
M. SENDER  :=  MY  NUMBER; 

PROCESSOR_BUFFl?R.  SEND  (M)  ; 

when  STATUS  |  NOISE  => 

—  from  call  processor;  send  on  to  phone 
M. SENDER  :=  MY_NUMBER; 

PHONE_BUFFERS(M. LINE_NUM) .SEND  (M) ; 

when  DETAIL  =>  null;  —  should  never  occur 

end  case; 

—  simulate  processor  time  used  to  handle  message 
HOLD  (ME,  HANDLING_TIME) ; 
end  loop; 

end  LINE  HANDLER; 


CSII.250 


SUMMARY 


SYNTAX 

-  designed  for  readability 
DECLARATIONS  and  TYPES 

-  factorization  of  properties,  maintainability 

-  abstraction,  hiding  of  implementation  details 

-  reliability,  due  to  checking 

-  floating  point  and  fixed  point,  portability 

-  access  types,  utility  and  security 

STATEMENTS 

-  assignment,  iteration,  selection,  transfer 

-  uniformity  of  syntax  (comb  structure) 

-  generally  as  simple  as  possible 

(e.g.,  iteration  control) 

SUB.  ]RAMS 

-  procedures  and  functions 

-  logically  described  parameter  modes 

(as  opposed  to  definition  by 
implementation  description) 

-  overloading 


PACKAGES 

-  modularity  and  abstraction 

-  structuring  for  complex  programs 

-  hiding  of  implementation,  maintainability 

-  major  uses : 

.  named  collections  of  declarations 
.  groups  of  related  subprograms 
.  encapsulated  data  types 


LIBRARIES 


-  separate  compilation 

-  generics 

-  program  development  environment 


TASKING 

-  can  be  done  completely  with  Ada  features 

-  single  concept  for  intertask  communication 

and  synchronization 

-  interface  with  external  devices 

-  designed  for  efficient  implementation 


EXCEPTION  HANDLING 

-  for  reliability  of  real-time  systems 

-  standard  vs.  user-defined  exceptions 

-  meant  mainly  for  handling  errors 

(rather  than  as  a  general  programming 
technique) 


MACHINE  DEPENDENCIES 

-  representation  specifications 

-  interface  with  other  languages 

-  low  level  I/O 


Ada  IS  DESIGNED  FOR 
WRITING  LARGE  PROGRAMS 

Ada  HAS  FEATURES  TO  ALLOW 
SUITABLE  EXTENSIONS  FOR 
A  PARTICULAR  APPLICATION 

Ada  IS  A  DESIGN  LANGUAGE 


What  haven't  we  discussed 


GO  TO  statements 


Representation  Specifications 


Details  of  Generics 


Input-Output 


Pragmas 


Inline  procedures 


Interface  to  other  languages 


HELBAT  BIFF 


Human 

Engineering 

Laboratories 

Battalion 

Artillery 

Test 

Battlefield 

Identification 

Friend 

or 

Foe 


PROBLEM  STATEMENT 


Fire  at  (and  hit)  enemy  targets 


Functional  specification  (par*ial) 


Input  from  -  radar  unit 

human  operator 

Output  to  -  human  operator 
remote  artillery 

LOCAL  WEAPON  CONTROL 


Operator  display  -  Plasma  Scope 

(nominally  9260  baud) 

Operator  input  device  -  Touch  Panel 
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RADAR  INPUT 


DMA  (DIRECT  MEMORY  ACCESS)  DUMP.  EVERY  20  MILLISECONDS 
ON  INTERRUPT  FROM  RADAR  HARDWARE.  OF  19  16-BIT  •WORDS". 

Format: 


WORD(S) 

BIT(S) 

MEANING 

0 

0 

*  • 

13 

ANTENNA  AZIMUTH 

1 

0 

•  • 

1 

1-ST  BEACON  ID 

1 

2 

•  • 

13 

1-ST  BEACON  RANGE 

2 

0 

•  • 

1 

2-ND  BEACON  ID 

2 

2 

9  9 

13 

2-ND  BEACON  RANGE 

3 

0 

9  9 

13 

CENTER  OF  SCAN  SECTOR 

4 

0 

IN  INTERROGATE  MODE  ? 

4 

1 

SEARCH  RANGE'  (SHORT, 

4 

2 

9  9 

3 

WIDTH  OF  SCAN  SECTOR 

4 

4 

9  9 

5 

DIRECTION  OF  SCAN 

4 

6 

9  9 

7 

RATE  OF  SCAN 

5..  17 

0 

9  9 

199 

RANGE  PROFILE 

18 

0 

9  9 

15 

ERROR_FL AG 

LONG) 
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POLICY  -  destroy  enenv  targets 


locate  a  target  - 


If  It's  not  friendly, 
then  destroy  it 


PERCEPTOR 


* 


perception 

of 

external 

end 

Internal 

states 


c 


POLICY 


\ 

/ 

PROCESSOR 

ESI 

decide  on 

cause 

basis  of 

N, 

dtnge 

,  \ 

policy  aid 

/ 

in 

1  / 
i 

perception 

external  or 

— 

i 

what  octlon 

internal 

i 

i 

to  take 

states 

i 

t 

i 

i 

\ 

• 

I 

» 

e 

n 

v 

1 

r 

o 

n 

ID 

e 

n 

t 


Actor  Model 


Processor  Implementation 


FOR  THIS  SYSTEM:  HUMAN  DECISION  MAKER 

ATTRIBUTES: 

INPUT  *  INFORMATION  RATE  ? 

PERCEIVABLE  STIMULI  ? 


OUTPUT  “  INFORMATION  RATE  ? 

MODES  (HANDS.  VOICE.  .. 


SYSTEM 


ALERTNESS 
RESPONSE  TIME 
proficiency 


(Embedded  Human  System) 


PERCEPTOR 

IMPLEMENTATION 


(  processor ) 


DISPLAY 


(  effector  ) 


PLASMA 

* 


PREPARATION 


SCOPE 


(  perceptor ) 


relate 

radar 

infomatlon 
to  display 

relate 
operator 
actions  to 
display 


DISPLAY 

PREPARATION 


( processor ) 


turn  display 
Infomatlon 
into 

emends  for 
Plasm  Scope 


( effector ) 


11 

send 

I 

amnds 

7 

to 

Plasm 

Scope 

(  buffer  ) 


EFFECTOR 

IMPLJEJENTATICN 


(  processor ) 

(  effector  ) 

interpret 

info  from 

1 

WEAPON 

touch  pcneL 

■ 

TRANSMITTER 

choose 

appropriate 

operations 

(  operator's 

display  ) 

INTERPRETER 
IPPLEMET4TAT1 014 


(  perceptor  ) 


(  processor  ) 


(  effector  ) 


RADAR 

INTERFACE 


RADAR 

DISPLAY 

GENERATOR 


WEAPON 


RADAR 

INTERFACE 


RADAR 

DISPLAY 

GENERATOR 


m 


HELBAT  BIFF 


Perceptor  - 

Sensor  -  (Radar) 

Operator's  Display  Handler 

Dis-play  Device  Command  Formatter 
Buffer 

Display  Device  Writer 
Environmental  Sensor  Information 
Sensor  Interface  _ 

Sensor  Information  Display  Generator 
Internal  Information  from  Operator  Commands 
Display  Device  -  (Plasma  Scope) 


Processor  -  (Human  Operator) 


Effector  - 

Operator  Input  Device  -  (Touch  Panel) 

Operator  Command  Handler 
Command  Dispatcher 
Operator  Input  Device  Reader 
Display  and  Effector  Control 
Cursor  Aiming 

Command  Indicator  Lighting 
Weapon  Aiming 

Target  Location  Transmission  Handler 


Weapon 

Transmitter 

Operator's  Display  Handler 
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with  Linked_List_FIFO_QUEUE.  RingJDueue* 
PROCEDURE  HELBAT_BIFF  IS 

package  Common.Definitions  is 
end’common_Definitionsi 


PACKAGE  OPERATOR_DlSPLAY_HANDLER  IS 

package  Display_Device_Command_Formatter  is 

package  Display  Device  Command_Buffer  is 
NEW  RlNG_QuEUE  (  ...  )« 

--  declarations  of  procedures  that  handle 
—  coding  and  buffering  of  commands  for 

--  OTHER  TASKS 

END  DlSPLAYj)EVICE_COMMAND_FORMATTER; 


TASK  TYPE  DISPLAY_DEVICE_WRITERj 


PACKAGE  SENSOR_lNFORMATION  IS 
PACKAGE  SENSOR_DEFINITIONS  IS 

end*Se*nsor  Definitions i 


task  type  Sensor  Interface  is 
--  declarations  of  entries  and 
--  representation  specification 
end  Sensor  Interface « 


TASK  TYPE  SENSOR_lNFORMATION_DlSPLAY_GENERATOR 
END  Sensor_Information  i 
END  OPERATOR_DISPLAY_HANDLERi 


j 

* 

I 


I 

I 

I 

I 


PACKAGE  0PERATOR_COMMAND_HANDLER  IS 

PACKAGE  OPERATOR_COMMAND_DEFINITIONS  IS 

end’operator  Command .Definitions! 


.  TASK  TYPE  COMMAND.DlSPATCHER  IS 
END*COMMAND  DISPATCHER! 


TASK  TYPE  OPERATOR_INPUT_DEVICE_READERi 


PACKAGE  DISPLAY_AND_EFFECT0R_C0NTR0L  IS 
PACKAGE  AlMING.iNFORMATION  IS 
ENd’AIMING.InFORMATION! 


task  type  Aiming  Cursor  Operations! 
task  type  Command  Indicator_Lighting! 

TASK  TYPE  WE APON.AIMINGj 

TASK  TYPE  TaRGETJ.OCATIONJTRAN$MISSION_HANDLER; 
END  DlSPLAY_AND_EFFECTOR_CONTROL! 

END  OPERATOR_COMMAND_HANDLER ! 


--  PACKAGE  BODIES  ARE  SEPARATELY  COMPILED 
•  •  • 

type  Display  Writer  is  access 

Operator_Display_Handler.DisplayJ)evice_Writer! 
—  Note:  this  type  points  to  tasks 
•  •  • 

PLASM  A_SC0PE.WRI  TER  :  Dl$PLAY_WRITER! 

•  ft  • 

BEGIN  —  BODY  OF  HELBATJ3IFF 
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BEGIN 


HELBAT  BIFF 


LOOP 

BEGIN  —  ACTIVATE  TASKS  IN  PROPER  ORDER 

•  •  • 

DELAY  10  *  SECONDS ; 

PL  ASM  A_SCOPE_WR  ITER  :»  NEW  Dl  SPL  A  Y_WRITER  ; 

•  mm 

END; 

END  LOOP; 

END  HELBATJIFF; 
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PACKAGE  SENSORjiEFINITIONS  IS 

F0URTEEN_BITSJU1L  :  CONSTANT  INTEGER  :«  16#3FFF#? 
SUBTYPE  RA2  IS  INTEGER  RANGE  0.  .FOURTEEN_BITSJ'ULLi 


SUBTYPE  RANGE_BlN  IS  INTEGER  RANGE  0 . .199* 

TYPE  Direction  IS  (NONE.  LEFT  TD_RIGHT,  RIGHT_TO_LEFT, 

SEARCHJ.IGHT)? 


for  Direction  use 


(NONE  •>  0. 
LEFT  TO  RIGHT  •>  1. 
RIGHT  TO  LEFT  »>  2. 
SEARCH  LIGHT  »>  3)? 


type  Profile  Of  Range  is 

array  T  Rang e_Bin' FIRST  ..  Rang e_Bin’ LAST  )  of  Boolean? 


type  Radar  Input  is 
record  “ 

ANTENNA  AZIMUTH 
FIRST  BEACON  ID 

first”beacon_ranse 

second_beacon_id 

SEC0ND_BEAC0N  RANGE 
CENTER  0F_SCAN_SECT0R 
IN_INTERROGATE_MODE 
SEARCH  RANGE 
WIDTH  OF  SCAN  SECTOR 
DIRECTION_OF_SCAN 
RATE_OF  SCAN 
RANGE_PROFILE 
ERROR  FLAG 
END  RECORD; 


RAZ; 

Integer  range  0. .3? 

Integer  range  0..M095? 
Integer  range  0. .3? 

Integer  range  0..H095? 

Raz? 

Boolean? 

Integer  range  0..1? 

Integer  range  0..3? 
Direction? 

Integer  range  0..3? 

Profile  Of_Range? 

Integer  range  0..16#ffff#? 
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PACKAGE  SENSOR_DEFINITIONS  IS 

F0URTEEN_BITSJULL  :  CONSTANT  INTEGER  :*  16#3FFF#; 


SUBTYPE  RAZ  IS  INTEGER  RANGE  0. ,FOURTEEN_BITS_FULL « 

SUBTYPE  RANGE.bin  IS  INTEGER  RANGE  0..199; 

TYPE  Direction  is  (NONE.  LEFT  TO  RIGHT.  RIGHT_TO_LEFT. 

SEARCH_LIGHT)T 


for  Direction  use  (NONE  »>  0. 

LEFT  TO  RIGHT  «>  1. 
RIGHT  TO  LEFT  ->  2. 
SEARCH  LIGHT  ->  3) « 


type  Profile  Of  Range  is 

array  T  Rang e_Bin' FIRST 

type  Radar  Input  is 
record 

ANTENNA  AZIMUTH 
FIRST  BEACON  ID 
FIRST_BEAC0N  range 

SECOND_BLACON_ID 
SECOND_.BE ACON  RANGE 
CENTER_OF  SCAN  SECTOR 
IN_INTERROGATE~MODE 
SEARCH_RANGE 
WIDTH_OF  SC AN_SECTOR 
DIRECTION  0F— SCAN 
RATE  OF_SCAN 

rangT_profile 

error_flag 

END  RECORD; 


..  Rang e_Bin’ LAST  )  of  Boolean; 


RAZi 

Integer  range  0..3; 

Integer  range  0..H095; 
Integer  range  0..3* 

Integer  range  0..H095; 

RaZ; 

Boolean; 

Integer  range  0. .1  • 

Integer  range  0..3; 
Direction? 

Integer  range  0..3; 

Profile  Of  Range; 

Integer  range  0. .16#FFFF#; 
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—  Package  Sensor_Definitions  (continued) 


for  Radar  Input  use 
record 

ANTENNA  A2IMUTH 
FlRST_BEACON_ID 
FIRST  BEACON  RANGE 
SECOND  BEACON  ID 
SECOND.BEACON  RANGE 
CENTER  OF  SCAN.SECTOR 
IN  INTERROGATE  MODE 
SEARCH  RANGE 
WIDTH  OF_SCAN_SECTOR 
DIRECTION  OF  SCAN 
RATE  OF  SCAN 
RANGE  PROFILE 
ERROR  FLAG 
END  RECORD* 


AT 

0 

• 

WORD 

Integer 

range 

0. .13* 

AT 

1 

• 

WORD 

Integer 

RANGE 

0..1* 

AT 

1 

• 

WORD  Integer 

RANGE 

2. .13* 

AT 

2 

* 

WORD 

Integer 

RANGE 

0..1* 

AT 

2 

• 

WORD  Integer 

RANGE 

2. .13* 

AT 

3 

• 

WORD 

Integer 

RANGE 

0. .13* 

AT 

M 

• 

WORD  Integer 

RANGE 

0.  .0* 

AT 

M 

• 

WORD 

Integer 

RANGE 

1..1* 

AT 

M 

• 

WORD  Integer 

RANGE 

2.. 3; 

AT 

M 

• 

WORD 

Integer 

RANGE 

H.  .5* 

AT 

H 

• 

WORD 

Integer 

range 

6. .7* 

AT 

5 

• 

WORD 

Integer 

range 

0..199* 

AT 

18 

• 

WORD  Integer 

RANGE 

0..15; 

RADAR_BUFFER  :  RADAR_lNPUTi 

RADAR_BUFFER_ADDRESS  *.  CONSTANT  INTEGER 
: *  radar_buffer'ADDRESS* 

radar_input_length  s  constant  Integer 
:»  19* 

end  Sensor  Definitions* 
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TASK  BODY  SENSOR  INTERFACE  IS 
USE  SENSOR_DEFINITIONSi 

procedure  Clear  theJ)MA  andjthe  Latch  is  ...  end* 
procedure  Set  up  the_DMA_/or  the  next  burst  IS  ...‘  END* 
PROCEDURE  SET_THE_tATCH_FOR_THEj5EXT_BMST  IS  ...  END* 

PRAGMA  PRIORITY ( SYSTEM'  MAX__PRIORITY ) « 

begin 

LOOP 

ACCEPT  0MA_FIN1SHED_INTERRUPT* 

Clear  the  DMA  and_theJ.atch* 

SE  T_UP_THEj»flLFOR_THE_NE X T_B URST  I 

SELECT 

ACCEPT  REQUEST  FOR  RADAR  INPUT(OUTPUT  :  OUT  SENSOR_lNPUT ) 
DO  OUTPUT  :•  RADAR_BUFFER « 

END* 

ELSE 

SEND  ERROR  MESSAGE  (  RADAR  OVERRUN  )t 
END  SELECT* 

SET_THEj.ATCH_F0R_THE_NEXT_8URST* 

END  LOOP* 

END  SENSOR.lNTERFACE* 
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procedure  Clear  the_DMA_and_.the.Utch  is 
USE  LOW_LEVEL_IOi 


BEGIN 

Send_Control  (  DMA.  (  CLEAR  )  )* 
Send  Control  (  LATCH.  (  CLEAR  )  h 
end  Clear  the  DMA_and_the_Latch« 


PROCEDURE  Set  up  T  H  E.DMA.FO  R_T  H  E.NE  X  T_B  UR  ST  IS 
USE  Low_LevelIIO, 


BEGIN 

Send  Control  (  DMA. 
SenoIControl  (  DMA, 
SEND  CONTROL  (  DMA. 
SenoIControl  (  DMA. 


Wk  II  u  VV  II  I  IWV  '  —  ■  "  ■  *  -  . . .  •  • 

end  SeOip_the  DMA_for_the_next_burst  I 


(SET  ADDRESS.  RADAR  BUFFER  ADDRESS)  )i 
(SETCOUNT.  -RADAR  TNPUT_LFN6TH)  )i 
(SETDIRECTION.  INWARDS)  )i 
( STAT?T ) )  i 


PROCEDURE  Set  the  Latch_for_the_next_burst  is 
USE  Low  LEVEL.IOi 
begin 

Send_Control  (  LATCH,  (START)  )» 

END  SET”THE_LATCH_F0R_THE_NEXT_BURST  i 
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PACKAGE  0PERAT0R_C0MMAND_DEFINITI0NS  IS 


type  Operator  Instruction  is 

(  DMD  SKINT  DltD  SPLASH. 

home  cursors,  park  cursors. 

AIM  RANGE  CURSORS.  AIM  AZIMUTH  CURSORS. 
TOGGLE  AZIMUTH  OR  RANG!. 

ACKNOWLEDGE  ERROR. 

AUTO  ERASE.  SLEW  WEAPON. 


RESTART.  ARM, 
UNIMPLEMENTED 


DISARM. 
) 


type  Operator  Command  (instruction  :  Operator_Instruction)  is 

RECORD 

case  instruction  is 
WHEN  AIM  CURSORS  -> 

AIM  DIRECTION  s  SCREENj)IRECTION t 
DELTA  INDEX  :  COORDINATEj/ALUE  * 

WHEN  OTHERS  •>  NULL* 

END  CASE  l 
END  RECORD! 


END  Operator_Command_Definitionsi 


CSIII.260 


separate  (Operator  CommandJHandler) 

TASK  BODY  OPERATOR_INPUT_DEVICE_RE ADER  IS 


PROCEDURE  CONVERT_THE  TOUCH  TO  A  COMMAND  IS 

x,  y  :  Coordinate  value *" 

COMMAND_VECTOR  s  INTEGER  RANGE  101  ..  1616* 
BEGIN 

CASE*COMMAND_VECTOR  IS 

WHEN  1023  •>  COMMAND  :•  (HOME  CURSOR)* 

WHEN  1M03  «>  COMMAND  (PAR)CCURSOR)  * 

WHEN ^OTHERS  ■>  COMMAND  :»  (UNIMPLEMENTED) * 
END  CASE* 

END  CONVERT_THE_TOUCH_TO_A_COMMAND I 


BEGIN  —  OPERATOR_lNPUTj)EVlCE  READER 
LOOP 

Read  a_touch* 

Convert  the  touch_to  a  command* 

CASE  COMMAND. INSTRUCTION  IS 

when  ARM  |  DISARM  I  UNIMPLEMENTED  •>  NULL* 

--  ARM  AND  DISARM  ARE  USED  BY  CONVERT_THEJTOUCH_ 

—  T0_A_C0f1MAND  TO  ARM  OR  DISARM  THE  TOUCH  PANEL  INPUT 
WHEN  OTHERS  «>  SEND  NEXT  (  COMMAND  )* 

—  Request  rendezvous  with  Operator  Command_Handler 

—  TO  PASS  A  GOOD  COMMAND  TO  IT 
END  CASE* 

END  LOOP* 

end  Operator  Input_Device  Reader* 
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TASK  BODY  COMMAND  DISPATCHER  IS 

USE  COMMAND.QUEUE,  0PERAT0R_C0MMAND.DE FINITIONS ! 

begin*  *  —  Command  Dispatcher 
loop 

SELECT 

accept  Send  next  (  Command  :  in  Operator.Comhand  )< 

DO  LATEST  COMMAND  :■  COMMAND! 

END  SEND.NEXTi 

Insert  (  latest.command  )« 

ELSE 

SELECT 

when’(current  command. instruction  •  AIM  RAKGE.CURSOR) 

OR  (CURRENT.COMMAND. INSTRUCTION  • 

AIM.AZIMUTH  CURSOR) 

OR  (CURRENT  COMMAND.INSTRUCTION  •  HOME  CURSORS) 

OR  (CURRENT"COMMAND  INSTRUCTION  •  PARlCCURSORS) 

OR  (currentIcommand.instructiqn  •  _ 

lOGGLE.AZIMUTH.OR.RANGE ) 

»> 

accept  Acouire  next  cursor.operation 

(COMMAND  i  OUT  OPERATOR  COMMAND) 

DO  COMMAND  :*  CURRENT  COMMAND! 

END  ACOUIRE.NEXT.CURSOR.OPERATION! 

end’selecti 

END*SE*LE*CT| 

END*LOOP! 

end  COMMAND.DISPATCHER! 
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